Jump to content
InfoFile
Tác giả: Tue_NV
Bài viết gốc: 82487
Tên lệnh: sxtt
Viết lisp theo yêu cầu [phần 2]

Yêu cầu này của Út thì Tue_NV đã làm rồi nhưng không thành công. Tue_NV chỉ có thể làm được yêu cầu thứ 2 và thứ 3 của Út khi Út chỉ chọn 1 nhóm Text đè lên nhau hoặc không đè lên nhau thôi nhé.
Đây là Lisp giãn Text đều ra 2 phía chỉ thực hiện với 1 nhóm Text
Yêu cầu thứ 2 và thứ 3 của Út được đáp ứng
Út chạy thử code này nhé :

Không biết khẩu AKA (ACA)...
>>

Yêu cầu này của Út thì Tue_NV đã làm rồi nhưng không thành công. Tue_NV chỉ có thể làm được yêu cầu thứ 2 và thứ 3 của Út khi Út chỉ chọn 1 nhóm Text đè lên nhau hoặc không đè lên nhau thôi nhé.
Đây là Lisp giãn Text đều ra 2 phía chỉ thực hiện với 1 nhóm Text
Yêu cầu thứ 2 và thứ 3 của Út được đáp ứng
Út chạy thử code này nhé :

Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.
Thanks bác
:rolleyes:
<<

Filename: 82487_sxtt.lsp
Tác giả: Tue_NV
Bài viết gốc: 69664
Tên lệnh: gb
Hỏi lisp về Region

Chào elleHCSC
Trước tiên Tue_NV xin cảm ơn bác Nguyễn Hoành. Từ đoạn Code của bác mà Tue_NV đã viết xong đoạn Code này để trợ giúp cho elleHCSC.
elleHCSC sử dụng đoạn Code này xem sao nhé :


@tranlaogia : Lisp ewb không thể làm được cái điều mà elleCHSC muốn lão gia ạ

Filename: 69664_gb.lsp
Tác giả: nguyentuyen6
Bài viết gốc: 116142
Tên lệnh: dd
TÍNH ĐỘ DÓC

Mình viết thử cái này xem đúng ý bạn không nhé. Chọn các số lần lượt như trong biểu thức của bạn gửi nhé!!!

Filename: 116142_dd.lsp
Tác giả: tiendung89
Bài viết gốc: 180098
Tên lệnh: tle goc gh gd gn cl cd dd tra hc are dc ca
Lisp vẽ trắc dọc mới
em có lisp trắc dọc thế này nhưng chưa dùng đc. nhờ các anh em trên diễn đàn chỉnh sửa giúp

;***********DAT TY LE************
(defun C:tle ()
(initget (+ 1 2 4))
(setq tld (getreal "\nTy le dung : "))
(setq tln (getreal "\nTy le ngang : "))
(setq dd (/ 1000 tld))
(setq nn (/ 1000 tln))
(setq tldn (* dd nn))
(setq hsd (/ 200.0 tld))
(setq hsn (/ 200.0 tln))
)
(if (=...
>>
em có lisp trắc dọc thế này nhưng chưa dùng đc. nhờ các anh em trên diễn đàn chỉnh sửa giúp

;***********DAT TY LE************
(defun C:tle ()
(initget (+ 1 2 4))
(setq tld (getreal "\nTy le dung : "))
(setq tln (getreal "\nTy le ngang : "))
(setq dd (/ 1000 tld))
(setq nn (/ 1000 tln))
(setq tldn (* dd nn))
(setq hsd (/ 200.0 tld))
(setq hsn (/ 200.0 tln))
)
(if (= tld nil) (c:tle))
;***********LAY TOA DO************
(defun C:goc ()
(setq pt (getpoint "\nGoc toa do: "))
(setq xxx (car pt) yyy (cadr pt))
(setq elst (entget (car (entsel "\nCao do moc: "))))
(if (= nil elst) (setq cdg 0) (setq cdg (atof (DXF 1 elst))))
(setq elst (entget (car (entsel "\nLy trinh moc: "))))
(if (= nil ltg) (setq ltg 0) (setq ltg (atof (DXF 1 elst))))
)
;***********GHI CAO DO************
(defun C:GH ()
(vmon)
(print)
(setq eclast (getvar "CMDECHO"))
(setq lalast (getvar "CLAYER"))
(setq oslast (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setq sy dd)
(command "layer" "s" 0 "")
(setvar "osmode" 512)
(print)
(print)
(setq pt (getpoint "\nDiem goc toa do <nearest to> : "))
(setq yo (cadr pt))
(setq pt (getpoint "\nNoi ghi cao do <nearest to> : "))
(setq y2 (cadr pt))
(setq y1 (- y2 (* 5 hso)))
(setq y3 (- yo hso))
(setvar "osmode" 1)
(setq pt (getpoint "\nDiem chuan <end of) : ") )
(setq yc (cadr pt))
(initget (+ 1 4))
(setq hc (getreal "\nGia tri cao do : "))
(setq dy (- (* sy hc) yc))
(setvar "osmode" 33)
(print)
(print)
(setq pt (getpoint "\nDiem : "))
(while (/= pt nil)
;;(setq pt (osnap pt "end"))
(setq x (car pt) y (cadr pt))
(setq h (/ (+ y dy) sy))
; (setq x1 (+ x 1))
(setvar "osmode" 0)
(command "layer" "s" "6" "")
(command "line" (list x yo) (list x y) "")
(command "layer" "s" "0" "")
(command "line" (list x y1) (list x y2) "")
(command "style" "2B" "" (* 1.8 hso) "" "" "" "" "" )
(setq x (+ x (* 2.3 hso)))
(command "text" "r" (list x y3) 90 (rtos h 2 2))
(setvar "osmode" 33)
(print)
(print)
(setq pt (getpoint "\nDiem : "))
)
(setvar "OSMODE" oslast)
(setvar "CLAYER" lalast)
(setvar "CMDECHO" eclast)
;;(setvar "OSMODE" 0)
)
;***********GHI CHIEU DAI************
(defun C:GD ()
(setq gdt 0.00)
(setq gdd 0.00)

(setq p1 (getpoint "\nPick first point_ "))
(setq p2 (getpoint p1 "\nPick second point_ "))

(setq x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2))

(setq dx (/ (abs (- y1 y2)) dd) dy (/ (abs (- x2 x1)) nn))

(setq gdd (sqrt (+ (* dx dx) (* dy dy))))
(print gdd)

(setq elst (entget (car (entsel "\nTEXT to replace: "))))
(setq elst (subst (cons 1 (rtos gdd 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***
;(defun C:GN ()
; (setq gdt 0.00)
; (setq gdd 0.00)
; (setq gdt (getdist "\nEnter distance or pick first point: "))
; (while (/= gdt nil)
; (setq gdd (+ gdd gdt))
; (setq gdt (getdist "\nEnter distance or pick first point: "))
; )
; (setq gdd (* (/ tln 1000.00) gdd))
; (print gdd)
; (setq elst (entget (car (entsel "\nTEXT to replace: "))))
; (setq elst (subst (cons 1 (rtos gdd 2 2)) (assoc 1 elst) elst))
; (entmod elst)
; (print)
;)
;***********GHI CU LY************
(defun C:CL ()
(setq gpt (getpoint "\nDiem can do: "))
(setq xg (car gpt))
(setq ddx (- xg xxx)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
)
(princ (strcat "\n Ly trinh: " (rtos ddx 2 2)))
(setq elst (entget (car (entsel "\nGhi vao_ "))))
(setq elst (subst (cons 1 (rtos ddx 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***********GHI CAO DO************
(defun C:CD ()
(setq gpt (getpoint "\nDiem can do: "))
(setq yg (cadr gpt))
(setq ddy (- yg yyy)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(princ (strcat "\n Cao do: " (rtos ddy 2 2)))
(setq elst (entget (car (entsel "\nGhi vao: "))))
(setq elst (subst (cons 1 (rtos ddy 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***********GHI DO DOC************
(defun c:dd ()
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point" pt1))
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
x (/ (+ x1 x2) 2)
y (/ (+ y1 y2) 2)
y (+ y (* 1.5 scale))
pt (list x y)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (> x2 x1)
(progn
(setq i (/ (* (- y1 y2) dd) (* (- x2 x1) nn))
i (strcat (rtos i 2 2) "%")
)
(princ (strcat "\n i%: " i))
(setq elst (entget (car (entsel "\nGhi do doc: "))))
(setq elst (subst (cons 1 i) (assoc 1 elst) elst))
(entmod elst)
)
(progn
(setq i (/ (* (- y1 y2) dd) (* (- x1 x2) nn))
i (strcat (rtos i 2 2) "%")
)
(princ (strcat "\n i%: " i))
(setq elst (entget (car (entsel "\nGhi do doc: "))))
(setq elst (subst (cons 1 i) (assoc 1 elst) elst))
(entmod elst)
)
)
(setvar "DIMZIN" DZ)
(setvar "OSMODE" OS)
)
;***********TRA LT , CD************
(defun C:tra ()
(setq gpt (getpoint "\nDiem can do: "))
(setq xg (car gpt) yg (cadr gpt))
(setq ddx (- xg xxx)
ddy (- yg yyy)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(alert (strcat "\n Cao do: " (rtos ddy 2 3) "\n Ly trinh: " (rtos ddx 2 3)))
)
;***********VE HUU CO************
(defun C:HC ()
(setq lalast (getvar "CLAYER"))
(setq oslast (getvar "OSMODE"))
(setq dy (* dd 0.2))
(command "layer" "n" "HUU-CO" "")
(command "layer" "c" "3" "HUU-CO" "")
(command "layer" "l" "dashed" "HUU-CO" "")
(command "layer" "s" "HUU-CO" "")
(setvar "OSMODE" 33)
(setq pt1 (getpoint "\nFrom : "))
(setq y1 (- (cadr pt1) dy))
(setq pt1 (list (car pt1) y1))
(setq pt2 (getpoint "To : "))
(while (/= pt2 nil)
(setq y2 (+ (cadr pt2) dy))
(setq pt2 (list (car pt2) y2))
(setvar "OSMODE" 0)
(command "line" pt1 pt2 "")
(setq pt1 pt2)
(setvar "OSMODE" 33)
(setq pt2 (getpoint "To : "))
)
(setvar "OSMODE" oslast)
(setvar "CLAYER" lalast)
);end of defun
;***********TINH DIEN TICH************
(defun c:are()
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "OSMODE" "0")
(print)
(if (not *InsT) (setq *InsT "R"))
(setq InsT (getstring (strcat "\nCreate or Replace TEXT? (C|R)<" *InsT ">: ")))
(if (= InsT "c") (setq InsT "C"))
(if (= InsT "r") (setq InsT "R"))
(if (= InsT "") (setq InsT *InsT) (setq *InsT InsT))
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 20 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(princ (strcat "\n" (rtos (/ dtcon tldn) 2 4) " Total: " (rtos (/ dtl tldn) 2 4)))
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(setvar "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tldn))
(princ (strcat "\nTotal : " (rtos dtl 2 4) "\n" ))
(cond
((= InsT "R")
(setq elst (entget (car (entsel "\nTEXT to replace: "))))
(setq adtl (rtos dtl 2 2))
(setq elst (subst (cons 1 adtl) (assoc 1 elst) elst))
(entmod elst)
)
((= InsT "C")
(setq pt2 (getpoint "\nPoint to creat TEXT: "))
(command "text" pt2 "0" (rtos dtl 2 4) )
)
)
(print)
);defun
;*********** DO DOC ************
(defun c:dc ( / OS DZ pt1 pt2 pt x1 x2 y1 y2 y i ang )
(if (= scale nil)
(progn
(setq scale (getreal "\nInput current scale: "))
)
)
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point" pt1))
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
x (/ (+ x1 x2) 2)
y (/ (+ y1 y2) 2)
y (+ y (* 1.5 scale))
pt (list x y)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (> x2 x1)
(progn
(setq i (/ (/ (- y1 y2) dd) (/ (- x2 x1) nn))
i (strcat (rtos (* i 100) 2 2) "%")
i (ustr 0 "Input i%: " i T)
ang (/ (* (angle pt1 pt2) 180) pi)
)
(command "INSERT" "ddoc" pt scale scale ang i)
)
(progn
(setq i (/ (/ (- y1 y2) dd) (/ (- x1 x2) nn))
i (strcat (rtos (* i 100) 2 2) "%")
i (ustr 0 "Input i%: " i T)
ang (/ (* (angle pt2 pt1) 180) pi)
)
(command "INSERT" "ddoc1" pt scale scale ang i)
)
)
(setvar "DIMZIN" DZ)
(setvar "OSMODE" OS)
)
;***********CHEN CAO DO************
(defun C:CA ()
(setq gpt (getpoint "\nPick Insertion Point")
ptside (getpoint "\nPick Side Point" gpt)
ang (angle gpt ptside)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq dz (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq xg (car gpt) yg (cadr gpt))
(setq ddx (- xg xxx)
ddy (- yg yyy)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(princ (strcat "\n Cao do: " (rtos ddy 2 2)))
(cond
((> ddy 0) (setq ddy (strcat "+" (rtos ddy 2 #acc))))
((< ddy 0) (setq ddy (rtos ddy 2 #acc)))
((= ddy 0) (setq ddy "%%p0.00"))
)
(if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "CD" gpt scale scale "0" ddy))
(if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "CD3" gpt scale scale "0" ddy))
(if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "CD2" gpt scale scale "0" ddy))
(if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "CD1" gpt scale scale "0" ddy))
(setvar "OSMODE" OS)
(setvar "DIMZIN" dz)
(print)
)

<<

Filename: 180098_tle_goc_gh_gd_gn_cl_cd_dd_tra_hc_are_dc_ca.lsp
Tác giả: tien2005
Bài viết gốc: 30604
Tên lệnh: ss
Xóa đối tượng theo lớp
Bạn có thể sử dụng lệnh sau đây để chọn các đối tượng, sau kết hợp với các lệnh copy, move, erase, ....

Filename: 30604_ss.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 179399
Tên lệnh: cvtc
Xin AE giúp chỉnh kích thước của cây cờ trong TD


Hề hề hề,
Kết quả này là do bạn chạy chương trình chi chi đó mà ra. Song vì mình là ngoại ngạch nên chả hiểu cái chương trình ấy mô tê ra sao cả nên chịu chết chẳng thể giúp bạn chỉnh sửa cái chi trong chương trình đó cả.
Tuy nhiên với cái bản vẽ của bạn gửi thì mình dùng lisp có thể đạt được cái yêu cầu bạn cần.
Trước hết căn cứ vào bản vẽ thì mình...
>>

Hề hề hề,
Kết quả này là do bạn chạy chương trình chi chi đó mà ra. Song vì mình là ngoại ngạch nên chả hiểu cái chương trình ấy mô tê ra sao cả nên chịu chết chẳng thể giúp bạn chỉnh sửa cái chi trong chương trình đó cả.
Tuy nhiên với cái bản vẽ của bạn gửi thì mình dùng lisp có thể đạt được cái yêu cầu bạn cần.
Trước hết căn cứ vào bản vẽ thì mình hiểu có nhẽ bạn định rút mấy cái cờ đó xuống thấp 25 đơn vị vẽ.
Vì thế trongf lisp mình để chế độ mặc định cho chiều cao cần rút là 25 đơn vị. Do đó nếu bạn chấp nhận điều này thì khi lisp yêu cầu nhập khoảng cách can chuyen bạn chỉ cần enter là Ok. Còn nếu bạn muốn kéo tụt xuống với khoảng cách khác thì hãy nhập giá trị đó vào đây. Còn nếu bạn muốn nâng cao nó lên thì hãy nhập một số âm.
Hãy lưu ý rằng, lisp này phù hợp với các thông số cấu trúc của cái cờ theo bản vẽ của bạn gửi. Khi cấu trúc cái cờ thay đổi tỷ như chiều cao text hay khung bao bên ngoài lớn lên hoặc cờ có nhiều cán thì có thể lisp sẽ không còn đúng nữa.
Hề hề hề, khi đó nếu muốn bạn có thể tự chỉnh lisp hoặc post bản vẽ lên mọi người sẽ giúp bạn chỉnh sửa để đạt yêu cầu của bạn.
Hề hề hề,
Chúc bạn vui.

PS: Dù sao bạn cũng nên tìm hiểu kỹ cái chương trình bạn đang sử dụng để có thể chỉnh ngay từ đó sẽ tốt hơn nhiều........
<<

Filename: 179399_cvtc.lsp
Tác giả: tiendung89
Bài viết gốc: 180100
Tên lệnh: tle goc gh gd gn cl cd dd tra hc are dc ca
Lisp vẽ trắc dọc mới
em có lisp trắc dọc thế này nhưng chưa dùng đc. nhờ các anh em trên diễn đàn chỉnh sửa giúp

;***********DAT TY LE************
(defun C:tle ()
(initget (+ 1 2 4))
(setq tld (getreal "\nTy le dung : "))
(setq tln (getreal "\nTy le ngang : "))
(setq dd (/ 1000 tld))
(setq nn (/ 1000 tln))
(setq tldn (* dd nn))
(setq hsd (/ 200.0 tld))
(setq hsn (/ 200.0 tln))
)
(if (=...
>>
em có lisp trắc dọc thế này nhưng chưa dùng đc. nhờ các anh em trên diễn đàn chỉnh sửa giúp

;***********DAT TY LE************
(defun C:tle ()
(initget (+ 1 2 4))
(setq tld (getreal "\nTy le dung : "))
(setq tln (getreal "\nTy le ngang : "))
(setq dd (/ 1000 tld))
(setq nn (/ 1000 tln))
(setq tldn (* dd nn))
(setq hsd (/ 200.0 tld))
(setq hsn (/ 200.0 tln))
)
(if (= tld nil) (c:tle))
;***********LAY TOA DO************
(defun C:goc ()
(setq pt (getpoint "\nGoc toa do: "))
(setq xxx (car pt) yyy (cadr pt))
(setq elst (entget (car (entsel "\nCao do moc: "))))
(if (= nil elst) (setq cdg 0) (setq cdg (atof (DXF 1 elst))))
(setq elst (entget (car (entsel "\nLy trinh moc: "))))
(if (= nil ltg) (setq ltg 0) (setq ltg (atof (DXF 1 elst))))
)
;***********GHI CAO DO************
(defun C:GH ()
(vmon)
(print)
(setq eclast (getvar "CMDECHO"))
(setq lalast (getvar "CLAYER"))
(setq oslast (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setq sy dd)
(command "layer" "s" 0 "")
(setvar "osmode" 512)
(print)
(print)
(setq pt (getpoint "\nDiem goc toa do <nearest to> : "))
(setq yo (cadr pt))
(setq pt (getpoint "\nNoi ghi cao do <nearest to> : "))
(setq y2 (cadr pt))
(setq y1 (- y2 (* 5 hso)))
(setq y3 (- yo hso))
(setvar "osmode" 1)
(setq pt (getpoint "\nDiem chuan <end of) : ") )
(setq yc (cadr pt))
(initget (+ 1 4))
(setq hc (getreal "\nGia tri cao do : "))
(setq dy (- (* sy hc) yc))
(setvar "osmode" 33)
(print)
(print)
(setq pt (getpoint "\nDiem : "))
(while (/= pt nil)
;;(setq pt (osnap pt "end"))
(setq x (car pt) y (cadr pt))
(setq h (/ (+ y dy) sy))
; (setq x1 (+ x 1))
(setvar "osmode" 0)
(command "layer" "s" "6" "")
(command "line" (list x yo) (list x y) "")
(command "layer" "s" "0" "")
(command "line" (list x y1) (list x y2) "")
(command "style" "2B" "" (* 1.8 hso) "" "" "" "" "" )
(setq x (+ x (* 2.3 hso)))
(command "text" "r" (list x y3) 90 (rtos h 2 2))
(setvar "osmode" 33)
(print)
(print)
(setq pt (getpoint "\nDiem : "))
)
(setvar "OSMODE" oslast)
(setvar "CLAYER" lalast)
(setvar "CMDECHO" eclast)
;;(setvar "OSMODE" 0)
)
;***********GHI CHIEU DAI************
(defun C:GD ()
(setq gdt 0.00)
(setq gdd 0.00)

(setq p1 (getpoint "\nPick first point_ "))
(setq p2 (getpoint p1 "\nPick second point_ "))

(setq x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2))

(setq dx (/ (abs (- y1 y2)) dd) dy (/ (abs (- x2 x1)) nn))

(setq gdd (sqrt (+ (* dx dx) (* dy dy))))
(print gdd)

(setq elst (entget (car (entsel "\nTEXT to replace: "))))
(setq elst (subst (cons 1 (rtos gdd 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***
;(defun C:GN ()
; (setq gdt 0.00)
; (setq gdd 0.00)
; (setq gdt (getdist "\nEnter distance or pick first point: "))
; (while (/= gdt nil)
; (setq gdd (+ gdd gdt))
; (setq gdt (getdist "\nEnter distance or pick first point: "))
; )
; (setq gdd (* (/ tln 1000.00) gdd))
; (print gdd)
; (setq elst (entget (car (entsel "\nTEXT to replace: "))))
; (setq elst (subst (cons 1 (rtos gdd 2 2)) (assoc 1 elst) elst))
; (entmod elst)
; (print)
;)
;***********GHI CU LY************
(defun C:CL ()
(setq gpt (getpoint "\nDiem can do: "))
(setq xg (car gpt))
(setq ddx (- xg xxx)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
)
(princ (strcat "\n Ly trinh: " (rtos ddx 2 2)))
(setq elst (entget (car (entsel "\nGhi vao_ "))))
(setq elst (subst (cons 1 (rtos ddx 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***********GHI CAO DO************
(defun C:CD ()
(setq gpt (getpoint "\nDiem can do: "))
(setq yg (cadr gpt))
(setq ddy (- yg yyy)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(princ (strcat "\n Cao do: " (rtos ddy 2 2)))
(setq elst (entget (car (entsel "\nGhi vao: "))))
(setq elst (subst (cons 1 (rtos ddy 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***********GHI DO DOC************
(defun c:dd ()
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point" pt1))
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
x (/ (+ x1 x2) 2)
y (/ (+ y1 y2) 2)
y (+ y (* 1.5 scale))
pt (list x y)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (> x2 x1)
(progn
(setq i (/ (* (- y1 y2) dd) (* (- x2 x1) nn))
i (strcat (rtos i 2 2) "%")
)
(princ (strcat "\n i%: " i))
(setq elst (entget (car (entsel "\nGhi do doc: "))))
(setq elst (subst (cons 1 i) (assoc 1 elst) elst))
(entmod elst)
)
(progn
(setq i (/ (* (- y1 y2) dd) (* (- x1 x2) nn))
i (strcat (rtos i 2 2) "%")
)
(princ (strcat "\n i%: " i))
(setq elst (entget (car (entsel "\nGhi do doc: "))))
(setq elst (subst (cons 1 i) (assoc 1 elst) elst))
(entmod elst)
)
)
(setvar "DIMZIN" DZ)
(setvar "OSMODE" OS)
)
;***********TRA LT , CD************
(defun C:tra ()
(setq gpt (getpoint "\nDiem can do: "))
(setq xg (car gpt) yg (cadr gpt))
(setq ddx (- xg xxx)
ddy (- yg yyy)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(alert (strcat "\n Cao do: " (rtos ddy 2 3) "\n Ly trinh: " (rtos ddx 2 3)))
)
;***********VE HUU CO************
(defun C:HC ()
(setq lalast (getvar "CLAYER"))
(setq oslast (getvar "OSMODE"))
(setq dy (* dd 0.2))
(command "layer" "n" "HUU-CO" "")
(command "layer" "c" "3" "HUU-CO" "")
(command "layer" "l" "dashed" "HUU-CO" "")
(command "layer" "s" "HUU-CO" "")
(setvar "OSMODE" 33)
(setq pt1 (getpoint "\nFrom : "))
(setq y1 (- (cadr pt1) dy))
(setq pt1 (list (car pt1) y1))
(setq pt2 (getpoint "To : "))
(while (/= pt2 nil)
(setq y2 (+ (cadr pt2) dy))
(setq pt2 (list (car pt2) y2))
(setvar "OSMODE" 0)
(command "line" pt1 pt2 "")
(setq pt1 pt2)
(setvar "OSMODE" 33)
(setq pt2 (getpoint "To : "))
)
(setvar "OSMODE" oslast)
(setvar "CLAYER" lalast)
);end of defun
;***********TINH DIEN TICH************
(defun c:are()
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "OSMODE" "0")
(print)
(if (not *InsT) (setq *InsT "R"))
(setq InsT (getstring (strcat "\nCreate or Replace TEXT? (C|R)<" *InsT ">: ")))
(if (= InsT "c") (setq InsT "C"))
(if (= InsT "r") (setq InsT "R"))
(if (= InsT "") (setq InsT *InsT) (setq *InsT InsT))
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 20 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(princ (strcat "\n" (rtos (/ dtcon tldn) 2 4) " Total: " (rtos (/ dtl tldn) 2 4)))
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(setvar "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tldn))
(princ (strcat "\nTotal : " (rtos dtl 2 4) "\n" ))
(cond
((= InsT "R")
(setq elst (entget (car (entsel "\nTEXT to replace: "))))
(setq adtl (rtos dtl 2 2))
(setq elst (subst (cons 1 adtl) (assoc 1 elst) elst))
(entmod elst)
)
((= InsT "C")
(setq pt2 (getpoint "\nPoint to creat TEXT: "))
(command "text" pt2 "0" (rtos dtl 2 4) )
)
)
(print)
);defun
;*********** DO DOC ************
(defun c:dc ( / OS DZ pt1 pt2 pt x1 x2 y1 y2 y i ang )
(if (= scale nil)
(progn
(setq scale (getreal "\nInput current scale: "))
)
)
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point" pt1))
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
x (/ (+ x1 x2) 2)
y (/ (+ y1 y2) 2)
y (+ y (* 1.5 scale))
pt (list x y)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (> x2 x1)
(progn
(setq i (/ (/ (- y1 y2) dd) (/ (- x2 x1) nn))
i (strcat (rtos (* i 100) 2 2) "%")
i (ustr 0 "Input i%: " i T)
ang (/ (* (angle pt1 pt2) 180) pi)
)
(command "INSERT" "ddoc" pt scale scale ang i)
)
(progn
(setq i (/ (/ (- y1 y2) dd) (/ (- x1 x2) nn))
i (strcat (rtos (* i 100) 2 2) "%")
i (ustr 0 "Input i%: " i T)
ang (/ (* (angle pt2 pt1) 180) pi)
)
(command "INSERT" "ddoc1" pt scale scale ang i)
)
)
(setvar "DIMZIN" DZ)
(setvar "OSMODE" OS)
)
;***********CHEN CAO DO************
(defun C:CA ()
(setq gpt (getpoint "\nPick Insertion Point")
ptside (getpoint "\nPick Side Point" gpt)
ang (angle gpt ptside)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq dz (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq xg (car gpt) yg (cadr gpt))
(setq ddx (- xg xxx)
ddy (- yg yyy)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(princ (strcat "\n Cao do: " (rtos ddy 2 2)))
(cond
((> ddy 0) (setq ddy (strcat "+" (rtos ddy 2 #acc))))
((< ddy 0) (setq ddy (rtos ddy 2 #acc)))
((= ddy 0) (setq ddy "%%p0.00"))
)
(if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "CD" gpt scale scale "0" ddy))
(if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "CD3" gpt scale scale "0" ddy))
(if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "CD2" gpt scale scale "0" ddy))
(if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "CD1" gpt scale scale "0" ddy))
(setvar "OSMODE" OS)
(setvar "DIMZIN" dz)
(print)
)

<<

Filename: 180100_tle_goc_gh_gd_gn_cl_cd_dd_tra_hc_are_dc_ca.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 180428
Tên lệnh: ha
Vẽ các đường đặc biệt của tam giác
Hôm qua có bạn y/c viết lisp để vẽ 1 số đường đặc biệt trong tam giác. Đang loay hoay viết thì topic bị xoá (có lẽ do bạn ấy mới vào CADViet nên chưa rõ quy định?). Sẵn đây viết luôn và post lên để khi nào ai cần thì dùng (nhớ thanks nhé!). Lisp vẽ được:
1). 3 Đường cao
2). 3 Đường phân giác trong
3). 3 Đường trung tuyến
4). 3 Đường trung trực
5). 1 Đường tròn nội...
>>
Hôm qua có bạn y/c viết lisp để vẽ 1 số đường đặc biệt trong tam giác. Đang loay hoay viết thì topic bị xoá (có lẽ do bạn ấy mới vào CADViet nên chưa rõ quy định?). Sẵn đây viết luôn và post lên để khi nào ai cần thì dùng (nhớ thanks nhé!). Lisp vẽ được:
1). 3 Đường cao
2). 3 Đường phân giác trong
3). 3 Đường trung tuyến
4). 3 Đường trung trực
5). 1 Đường tròn nội tiếp
6). 1 Đường tròn ngoại tiếp
Riêng 3 đường tròn bàng tiếp và 3 đường phân giác ngoài do ít dùng nên chưa viết.
Nếu chủ đề này đã có rồi thì mong bỏ qua cho, vì trước khi viết cũng đã thử tìm mà chưa thấy.
Thân thương!

<<

Filename: 180428_ha.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 180603
Tên lệnh: glt
Lisp tính lý trình các điểm trên 1 polyline/line


Hề hề hề,
Nó bảo bạn rằng không có hệ tọa độ nào của người dùng được tạo ra trước đó cả. và thế là nó out.
Như vậy chứng tỏ rằng cái bản vẽ này của bạn khác với cái bản vẽ cũ. Và đó cũng chính là điều mà người dùng lisp nhiều khi không lưu ý đến điều này. Mỗi lisp được viết ra có thể chỉ phù hợp với một số giới hạn các cấu trúc bản vẽ mà...
>>

Hề hề hề,
Nó bảo bạn rằng không có hệ tọa độ nào của người dùng được tạo ra trước đó cả. và thế là nó out.
Như vậy chứng tỏ rằng cái bản vẽ này của bạn khác với cái bản vẽ cũ. Và đó cũng chính là điều mà người dùng lisp nhiều khi không lưu ý đến điều này. Mỗi lisp được viết ra có thể chỉ phù hợp với một số giới hạn các cấu trúc bản vẽ mà thôi.
Bạn đã sửa cái lisp này có đúng như mình nói không???
Bạn hãy thử cái này xem sao nhé:


Nếu vẫn không được thì bạn hãy bỏ dòng code (command "ucs" "p") đi nhé. Vì dòng này sẽ trả bản vẽ về hệ tọa độ người dùng sử dụng trước đó khi nó tồn tại.
Lúc này bạn phải lư ý rằng tất cả các bản vẽ khi sử dụng lisp này sẽ bị trả hết về hệ tọa độ World và nếu muốn sử dụng lại các hệ tọa độ cũ bạn phải tự làm bằng cách sử dụng lệnh ucsman.

Chúc bạn vui.
<<

Filename: 180603_glt.lsp
Tác giả: nguyentuyen6
Bài viết gốc: 138858
Tên lệnh: test
DCL
Mình có cái Lisp như thế này:


Cho e hỏi làm sao để sau khi chọn nút Pick thì nó lại hiện lên bảng chọn tiếp!!!

Filename: 138858_test.lsp
Tác giả: ssg
Bài viết gốc: 49015
Tên lệnh: bdt
Chia đất!!!

1. Lệnh massprop chỉ tác dụng với region hoặc 3dsolid. Trong bản vẽ của ssg, chỉ có pline kín. Muốn biết diện tích, anh bấm chọn nó, gõ MO sẽ thấy area.

2. Dù có "vẽ theo hàm", kết quả cũng là một tập hợp rời rạc các điểm. Cái khác nhau giữa làm thủ công và dùng chương trình là anh có thể chọn số điểm lớn tuỳ ý (nhờ tốc độ xử lý nhanh) -> độ chính xác tăng lên (cũng...
>>

1. Lệnh massprop chỉ tác dụng với region hoặc 3dsolid. Trong bản vẽ của ssg, chỉ có pline kín. Muốn biết diện tích, anh bấm chọn nó, gõ MO sẽ thấy area.

2. Dù có "vẽ theo hàm", kết quả cũng là một tập hợp rời rạc các điểm. Cái khác nhau giữa làm thủ công và dùng chương trình là anh có thể chọn số điểm lớn tuỳ ý (nhờ tốc độ xử lý nhanh) -> độ chính xác tăng lên (cũng có thể tuỳ ý) nhưng không bao giờ đạt được "độ chính xác tuyệt đối" như trong toán học lý thuyết. Ngay cả các đối tượng AutoCAD vẫn là một tập rời rạc các điểm. AutoCAD, hay bất kỳ trình CAD nào khác, cũng chỉ xử lý đến một độ chính xác nào đó theo khả năng cũng như mức độ chấp nhận được của kỹ thuật thôi.

3. Các hệ số hoặc số mũ trong 2 phương trình anh nêu lên không đúng theo hình biên dạng tàu trong bản vẽ anh đã post. Anh thử thay số y=23.5 vào phương trình đầu xem, kết quả nhận được là 475.xxxx chứ không phải là 27 như trên bản vẽ.

4. Cả 2 phương trình của anh đều có một dạng tổng quát:

X = k1.Ym + k2.Y2m

với k1, k2, m có thể >0 hoặc <0

Anh dùng lisp sau để vẽ đồ thị dạng trên, lệnh BDT (biên dạng tàu):


Chương trình yêu cầu nhập các hệ số và số mũ, giá trị Ymin, Ymax và số đoạn chia. Mặc định số đoạn chia ban đầu là 100 trong dấu móc nhọn (nếu chấp nhận chỉ Enter không cần nhập số). Giá trị số đoạn chia của lần chạy trước sẽ tự nhớ cho các lần chạy sau. Anh muốn tăng độ chính xác thì tăng số đoạn chia lên. Cái giá phải trả như ssg đã nói ở bài trước.
<<

Filename: 49015_bdt.lsp
Tác giả: gia_bach
Bài viết gốc: 26704
Tên lệnh: 0%2B
Viết Lisp theo yêu cầu


Bạn dùng thử đoạn code này xem sao.

Filename: 26704_0%2B.lsp
Tác giả: lp_hai
Bài viết gốc: 181363
Tên lệnh: zs
Viết hộ em cái lisp thế này. Cám ơn!
nếu cái khung bên model của bạn là một rectang thì bạn có thể xài lisp này. Sau khi bạn gõ lệnh zs bạn chọn cái khung là lisp làm việc!!
(defun c:zs(/ dt)
(command "Mspace")
(setq dt (car(entsel))
)
(command "zoom" (vlax-curve-getPointatParam dt 1) (vlax-curve-getPointatParam dt 3))
(command "pspace")
(princ)
)

Filename: 181363_zs.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 181420
Tên lệnh: xcd
Lisp xuất cao độ tại cọc

Hề hề hề,
Bạn cần nói rõ việc xuất tọa độ này là xuất ra sao? Xuất nguyên cụm tọa độ bao gồm cả x,y,z vào một cột hay xuất thành 3 cột là cột x cột y, cột z.
Đây là cái mình thử sửa để bạn có thể xuất thành 3 cột tọa độ riêng biệt x,y,z theo đúng với tọa độ hiện hành của CAD. Nếu bạn muốn xuất thành một cột thì phải sử dụng thêm hàm ghép các text tọa...
>>

Hề hề hề,
Bạn cần nói rõ việc xuất tọa độ này là xuất ra sao? Xuất nguyên cụm tọa độ bao gồm cả x,y,z vào một cột hay xuất thành 3 cột là cột x cột y, cột z.
Đây là cái mình thử sửa để bạn có thể xuất thành 3 cột tọa độ riêng biệt x,y,z theo đúng với tọa độ hiện hành của CAD. Nếu bạn muốn xuất thành một cột thì phải sử dụng thêm hàm ghép các text tọa độ lại với nhau. bạn hãy thử xem nhé và có gì thì post lên do mình chưa có thời gian test lại.

Hy vọng đúng ý bạn.
Chúc bạn vui.
<<

Filename: 181420_xcd.lsp
Tác giả: VUVUZELA
Bài viết gốc: 108771
Tên lệnh: mm
nhờ các anh chị viết dùm em lisp chọn layer 0
Đây tặng chú em nè
Có j không hiểu cứ pm đại ka
:(


Filename: 108771_mm.lsp
Tác giả: thanhdatkts
Bài viết gốc: 181646
Tên lệnh: dt cv
lisp tính tổng diện tích và chu vi các hình

(defun c:dt()
;tinh dien tich 1 hinh khep kin
(setq p (getpoint "Chon khu vuc kin can tinh dien tich:"))
(command "boundary" p "")
(command "area" "e" "l")
(command "erase" "l" "" )
(command "color" "bylayer")
(command "text" "m" p pause "0" (strcat "%%u" "Dien t&#237;ch = "...
>>

(defun c:dt()
;tinh dien tich 1 hinh khep kin
(setq p (getpoint "Chon khu vuc kin can tinh dien tich:"))
(command "boundary" p "")
(command "area" "e" "l")
(command "erase" "l" "" )
(command "color" "bylayer")
(command "text" "m" p pause "0" (strcat "%%u" "Dien t&#237;ch = " (rtos (/ (getvar "area" ) 1000000) 2 2) " m2" ))
(command "redraw" )
)
(defun c:cv()
;tinh chu vi 1 hinh khep kin
(setq p (getpoint "Chon khu vuc kin can tinh chu vi:"))
(command "boundary" p "")
(command "area" "e" "l")
(command "erase" "l" "" )
(command "color" "bylayer")
(command "text" "m" p pause "0" (strcat "%%u" "Chu vi = " (rtos (/ (getvar "perimeter" ) 1000) 2 2) " m" ))
(command "redraw" )
)
mình có 1 lisp tính diện tích và chu vi rồi...nhưng cái hạn chế của nó chỉ tính cho 1 pline liền và vì công việc tính khối lượng nên cộng các hình hơi mất thời gian.....

mong các pro có thể giúp sửa nó tính cho nhiều hình thay vì chỉ có 1 hình

link ví dụ http://www.mediafire...anjdyg4oz7pykr4

thank các pro
<<

Filename: 181646_dt_cv.lsp
Tác giả: lp_hai
Bài viết gốc: 181668
Tên lệnh: tdt tcd
lisp tính tổng diện tích và chu vi các hình

Mình thấy theo cách chọn vùng để tính chu vi và diện tích bằng cách pick điểm thì ko ổn, vì nếu bạn muốn pick vào nhiều vùng khác nhau thì phải zoom toàn bộ vùng đó giống như trong lệnh Hatch. vì vậy nếu muốn dùng tốt lisp tính diện tích cũng như chu vi cho nhiều hình thì chọn các hình bằng cách chọn đối tượng là khả thi hơn!
Trên diễn đàn có rất nhiều lisp tính diện tích chu vi....
>>

Mình thấy theo cách chọn vùng để tính chu vi và diện tích bằng cách pick điểm thì ko ổn, vì nếu bạn muốn pick vào nhiều vùng khác nhau thì phải zoom toàn bộ vùng đó giống như trong lệnh Hatch. vì vậy nếu muốn dùng tốt lisp tính diện tích cũng như chu vi cho nhiều hình thì chọn các hình bằng cách chọn đối tượng là khả thi hơn!
Trên diễn đàn có rất nhiều lisp tính diện tích chu vi. Mình gửi bạn cái của mình đang xài. Bạn có thể tham khảo!

(defun c:tdt(/ dt sdt gt tgt id pt1)
(setq dt (ssget)
sdt (sslength dt)
id 0
tgt 0)
(repeat sdt
(setq ent (ssname dt id)
id (1+ id)
)
(command "area" "o" ent "")
(setq gt (getvar "area"))
(setq tgt (+ tgt gt))
(princ)
)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
(command "text" "j" "mc" pt1 "250" "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
(setq dt (ssget '((-4 . "<OR")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "ARC")
(0 . "LINE")
(0 . "*POLYLINE")
(-4 . "OR>")
))
)
(setq sdt (sslength dt))
(setq
index 0
tcd 0
)
(repeat sdt
(setq
ent (ssname dt index)
index (1+ index)
)
(command "lengthen" ent "")
(setq cd (getvar "perimeter"))
(setq tcd (+ tcd cd))
)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
(command "text" "j" "mc" pt1 "250" "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
(princ)
)


<<

Filename: 181668_tdt_tcd.lsp
Tác giả: gia_bach
Bài viết gốc: 86707
Tên lệnh: test
viết lisp thống kê bản vẽ

Bạn tham khảo

Filename: 86707_test.lsp
Tác giả: tuanlongtl
Bài viết gốc: 42100
Tên lệnh: vtd
Viết Lisp theo yêu cầu
đoạn code này sai ở chỗ nào vậy các bạn? Ai biết xin chỉ giáo dùm

Ai

Filename: 42100_vtd.lsp
Tác giả: VUVUZELA
Bài viết gốc: 100752
Tên lệnh: lfa3
Viết lisp nối suy đỉnh đường cong tròn
Mạn phép thay đổi 1 tý cho em nó nhé bác Nguyen Hoanh
Cho có 1 tý tự động

Filename: 100752_lfa3.lsp

Trang 61/319

61