Jump to content
InfoFile
Tác giả: ketxu
Bài viết gốc: 200487
Tên lệnh: tkd
Lisp thống kê kích thước trong bản vẽ cad

Visual Lisp :

(defun c:tkd(/ lstval stp lst pw)
(setq stp 2) ;Dong nay quy dinh so le muon in ra
(cond ((ssget (list (cons 0 "DIMENSION")))
(defun dimval (e / a)(if (= (setq a(vla-get-TextOverride e)) "")
(rtos (vla-get-Measurement e) 2 stp)
(rtos (distof a) 2 stp)))
(vlax-for dObj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (not (assoc (setq b (dimval dObj)) lst))
>>
Visual Lisp :

(defun c:tkd(/ lstval stp lst pw)
(setq stp 2) ;Dong nay quy dinh so le muon in ra
(cond ((ssget (list (cons 0 "DIMENSION")))
(defun dimval (e / a)(if (= (setq a(vla-get-TextOverride e)) "")
(rtos (vla-get-Measurement e) 2 stp)
(rtos (distof a) 2 stp)))
(vlax-for dObj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (not (assoc (setq b (dimval dObj)) lst))
(setq lst (cons (cons b 1) lst))
(setq lst (subst (cons b (1+ (cdr (assoc b lst))))(assoc b lst) lst))
)
)
(setq pw (open (getfiled "Chon file de xuat ket qua" "" "xls" 1) "w"))
(write-line (strcat "Chieu dai" "\t" "So luong") pw)
(mapcar '(lambda(x)(write-line (strcat (car x) (chr 9) (itoa (cdr x))) pw)) lst)
(close pw)
)
)
)

<<

Filename: 200487_tkd.lsp
Tác giả: ketxu
Bài viết gốc: 200508
Tên lệnh: test
Lisp đo tổng khoảng cách AB + CD nằm trên 2 đường Pline khác nhau


:) Thế mới khó lường. Ngắn gọn và xúc tích :D Trong khi đáng ra chỉ cần 1 dòng miêu tả, cũng chẳng cần file bạn ạ


(defun c:test() (+ (distance (setq a (getpoint "\nA :")) (getpoint a...
>>


:) Thế mới khó lường. Ngắn gọn và xúc tích :D Trong khi đáng ra chỉ cần 1 dòng miêu tả, cũng chẳng cần file bạn ạ


(defun c:test() (+ (distance (setq a (getpoint "\nA :")) (getpoint a "\nB:"))(distance (setq c(getpoint "\nC:")) (getpoint c "\nD:"))))

<<

Filename: 200508_test.lsp
Tác giả: ketxu
Bài viết gốc: 199658
Tên lệnh: test
Lisp insert field file name bỏ đi một số ký tự
K được là k đc thế nào ?
Mình chỉ thấy nó tự quy định ký tự đầu là dấu " ", cò chẳng thấy k được chỗ nào. Chủ đề đã trả lời cách đây 9 ngày, chả hiểu bạn có cần thật hay thích thì hỏi

(defun c:test()(vl-load-com)
(vla-addmtext (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
(vlax-3d-point (getpoint "\nDiem chen Field"))
...
>>
K được là k đc thế nào ?
Mình chỉ thấy nó tự quy định ký tự đầu là dấu " ", cò chẳng thấy k được chỗ nào. Chủ đề đã trả lời cách đây 9 ngày, chả hiểu bạn có cần thật hay thích thì hỏi

(defun c:test()(vl-load-com)
(vla-addmtext (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
(vlax-3d-point (getpoint "\nDiem chen Field"))
1
(strcat "%<$(substr, $(getvar, dwgname)," (itoa (1+ (setq a (getint "\nBat dau tu so:")))) "," (itoa (getint "\nSo ky tu :")) ")>%")
))

Nói luôn là diễn đàn k đồng tình việc tạo 2 hoặc nhiều nick để hút máu mọi người đâu. Bạn có thắc mắc thì cứ hỏi, ai cũng hỏi cả mà, không việc chi phải thay tên đổi nick bạn ạ :)
<<

Filename: 199658_test.lsp
Tác giả: Tue_NV
Bài viết gốc: 200646
Tên lệnh: test
LISP tạo đường viền cho text

Sửa lại cho bạn đây :

Filename: 200646_test.lsp
Tác giả: pdle
Bài viết gốc: 200738
Tên lệnh: bst
Lisp xóa layer Defpoints
Bình thường, layer Defpoints không thể xóa được. Tuy nhiên trong một số trường hợp vẫn nảy sinh nhu cầu xóa cái layer này. Hôm trước em phát hiện ra là để xóa layer này, cần phải làm:

1. Xóa hết các dimension
2. Purge các block có dạng: *D1, *D2,...
3. Đổi tên layer Defpoints thành tên khác, ví dụ : deletelayer
4. Purge layer deletelayer này là xong

Vì phải thực hiện nhiều...
>>
Bình thường, layer Defpoints không thể xóa được. Tuy nhiên trong một số trường hợp vẫn nảy sinh nhu cầu xóa cái layer này. Hôm trước em phát hiện ra là để xóa layer này, cần phải làm:

1. Xóa hết các dimension
2. Purge các block có dạng: *D1, *D2,...
3. Đổi tên layer Defpoints thành tên khác, ví dụ : deletelayer
4. Purge layer deletelayer này là xong

Vì phải thực hiện nhiều lần, nên em đã viết lisp sau. Share lên đây cho cả nhà, ai thấy lisp chưa ổn chỗ nào thì mong bớt chút thời gian cho em ý kiến với:


;;; Written by pdle
(defun c:bst()
(setq lb (list (cdr (assoc 2 (tblnext "block" T))))) ; Reset cho tblnext chay tu dau bang block
(while (and(not (member (setq vbl(cdr (assoc 2 (tblnext "block")))) lb)) vbl)
(setq lb (cons vbl lb))
) ; Lay het ten cac block
(setq sd (ssget "_X" (list (cons 0 "DIMENSION"))))
(if sd
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex sd)))
(entdel ent)
)
) ; Xoa het dimension
(foreach ent lb
(if (=(substr ent 1 2) "*D") (command "-purge" "b" ent "y" "y"))
) ; Purge cac block dang *D
(if (tblsearch "layer" "Defpoints")
(progn
(command "-rename" "la" "Defpoints" "deletelayer")
(command "-purge" "la" "deletelayer" "y" "y")
)
) ; Doi ten cho Defpoints va xoa no
)


Em có 2 câu hỏi sau:

1) Trong trường hợp command của CAD không thực hiện được lệnh, chẳng hạn lệnh purge không purge được block, thì làm thế nào để có thể kiểm soát bằng lisp

2) Các block dạng *E1, *E2 là liên quan đến gì trong CAD (chẳng hạn *D1, *D2,... thì liên quan đến Dimension)
<<

Filename: 200738_bst.lsp
Tác giả: amateurday
Bài viết gốc: 200772
Tên lệnh: pp
code đổi dấu "\\" thành "\" trong path file

Nhờ code trên cadviet, nên nó như thế này:

(defun c:pp (/ text)
(SetClipBoardText (vl-string-translate "\\" "/" (getvar 'dwgprefix)))
)
(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
(if (= 'STR (type text))
(progn
(setq htmlfile (vlax-create-object "htmlfile")
result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text ) )
>>
Nhờ code trên cadviet, nên nó như thế này:

(defun c:pp (/ text)
(SetClipBoardText (vl-string-translate "\\" "/" (getvar 'dwgprefix)))
)
(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
(if (= 'STR (type text))
(progn
(setq htmlfile (vlax-create-object "htmlfile")
result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text ) )
(vlax-release-object htmlfile)
text
))
)

<<

Filename: 200772_pp.lsp
Tác giả: hoangkimoanh
Bài viết gốc: 200781
Tên lệnh: 1 11
nhờ các anh gộp giúp em lisp lệnh bật, tắt Layer với

em hay dùng tắt, bật layer khi vẽ. em cần giúp gộp đoạn code dưới đây thành 1 lệnh tắt hay bật Layer đều bằng 1 lệnh.
VD: bấm số 1 lúc đầu là tắt Layer, sau muốn hiện Layer lên lại thì lại bấm số 1 là nó hiện lại nhưng Layer đã tắt. cảm ơn các anh rất nhiều.

(defun c:1() (prompt "\nGO SO 1: DE TAT TUNG LAYER TUY CHON")(c:LAYOFF))
(defun c:11() (prompt "\nGO SO 2: DE MO TAT CA...
>>
em hay dùng tắt, bật layer khi vẽ. em cần giúp gộp đoạn code dưới đây thành 1 lệnh tắt hay bật Layer đều bằng 1 lệnh.
VD: bấm số 1 lúc đầu là tắt Layer, sau muốn hiện Layer lên lại thì lại bấm số 1 là nó hiện lại nhưng Layer đã tắt. cảm ơn các anh rất nhiều.

(defun c:1() (prompt "\nGO SO 1: DE TAT TUNG LAYER TUY CHON")(c:LAYOFF))
(defun c:11() (prompt "\nGO SO 2: DE MO TAT CA CAC LAYER DA TAT")(c:LAYON))

<<

Filename: 200781_1_11.lsp
Tác giả: vantuan18nd
Bài viết gốc: 200788
Tên lệnh: h1
Lisp tính cao độ của mình khi tính xong thì các cao độ tìm được luôn nằm lệch sang bên trái điểm cần tìm.
Mình nhờ các bạn sửa lại cho mình : sao cho các số cao độ tìm được có điểm cần tìm làm trung tâm.


(defun c:h1 ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)
(setvar "osmode" 1)
(command "ucs" "w")
(setq pt (getpoint "\nChon diem da biet cao...
>>
Lisp tính cao độ của mình khi tính xong thì các cao độ tìm được luôn nằm lệch sang bên trái điểm cần tìm.
Mình nhờ các bạn sửa lại cho mình : sao cho các số cao độ tìm được có điểm cần tìm làm trung tâm.


(defun c:h1 ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)
(setvar "osmode" 1)
(command "ucs" "w")
(setq pt (getpoint "\nChon diem da biet cao do: ")
ent (entget(car(entsel "\nChon gia tri cao do cho diem vua xong: ")))
etype (cdr(assoc 0 ent))
txth (cdr(assoc 40 ent))
)
(if (/= etype "TEXT") (progn
(princ "\nGia tri ban chon khong phai la so")
(exit))
(setq elev (atof(cdr(assoc 1 ent))))
)
(command "layer" "m" "UNSUITABLE" "")
(while (setq p1(getpoint "\nChon diem can tim cao do"))
(setq elev1 (+ elev (- (cadr p1) (cadr pt)))
offset (abs(- (car p1) (car pt)))
p01 (polar p1 (* 3.0 (/ pi 2)) txth)
p01 (polar p01 pi (* 0.9 txth))
p02 (polar p01 0 (* 1.6 txth))
ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "" (rtos elev1 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p01) (cadr p01) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(princ "\nNhan ESC hoac SPACE bar de huy lenh")
)
(end_task)
)

<<

Filename: 200788_h1.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 200816
Tên lệnh: ha
Nhờ viết lisp chọn nhanh text cùng nội dung

Đây bạn ơi! Lisp chọn text cùng nội dung.

Filename: 200816_ha.lsp
Tác giả: tien2005
Bài viết gốc: 200857
Tên lệnh: test
về lệnh getstring
mình dùng acad2007 sử dụng lisp sau:

(defun c:test()
(setq t1 (getstring T "\nNhap noi dung text 1: ")
t2 (getstring T "\nNhap noi dung text 2: ")
t3 (strcat t1 t2)
)
)


Vấn đề đặt ra là cách nhập text (t1 và t2) trên dong lệnh command và tại vị trí con trỏ trên màn hình:
- Nhập trên dòng lệnh thì các text t1 và t2 vẫn đầy đủ
vd: t1 "Forum...
>>
mình dùng acad2007 sử dụng lisp sau:

(defun c:test()
(setq t1 (getstring T "\nNhap noi dung text 1: ")
t2 (getstring T "\nNhap noi dung text 2: ")
t3 (strcat t1 t2)
)
)


Vấn đề đặt ra là cách nhập text (t1 và t2) trên dong lệnh command và tại vị trí con trỏ trên màn hình:
- Nhập trên dòng lệnh thì các text t1 và t2 vẫn đầy đủ
vd: t1 "Forum " và t2 " CadViet " => "Forum CadViet "

- Nhập tại vị trí con trỏ thì các text bị mất khoảng trắng đầu và cuối
vd: t1 "Forum " và t2 " CadViet" => "ForumCadViet"

Vậy có cách nào để khắc phục cho cách nhập tại vị trí con trỏ không? hoặc có biến hệ thống nào để cài đặt bắt buộc chỉ được nhập tại dòng lệnh command

Thanks
<<

Filename: 200857_test.lsp
Tác giả: vantuan18nd
Bài viết gốc: 200866
Tên lệnh: mul sum
đo khoảng cách bằng chỉ bằng 1 lần rê chuột


Lisp của mình cần cũng tương tự như Link trên .Nhưng thay vì kết quả là tính "Sum" hay "Mul" thì của mình là "khoảng cách" và đối tượng được chọn của mình là Line hoặc Pline chứ không phải là TEXT
( Ý mình là muốn đo khoảng cách giữa các đường màu đỏ, và kết quả mình sẽ chọn Text để ghi thay thế)
Các bác xem và chỉnh sửa hộ nhé !
>>


Lisp của mình cần cũng tương tự như Link trên .Nhưng thay vì kết quả là tính "Sum" hay "Mul" thì của mình là "khoảng cách" và đối tượng được chọn của mình là Line hoặc Pline chứ không phải là TEXT
( Ý mình là muốn đo khoảng cách giữa các đường màu đỏ, và kết quả mình sẽ chọn Text để ghi thay thế)
Các bác xem và chỉnh sửa hộ nhé !

;;;-----------------------------------------
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon cac text can tinh:")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tChon text ghi ket qua:")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:MUL( / i m e ss)
(SelData) (setq i 0 m 1.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))
(WriteRes m)
)
;;;-----------------------------------------
(defun C:SUM( / i s e ss)
(SelData) (setq i 0 s 0.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))
(WriteRes s)
)
;;;-----------------------------------------

<<

Filename: 200866_mul_sum.lsp
Tác giả: hacoi123321
Bài viết gốc: 200879
Tên lệnh: cv
Nhờ các bác giúp em lips thực hiện hàm lặp.


Em xin lỗi vì em giải thích ý tưởng của em nhưng mãi ko ai hiểu. Không biết các bác có xem file đính kèm cuối cùng của em chưa, nếu xem rồi, chỉ cần các bác giúp em làm được như ví dụ trong file đính kèm đó là em cảm ơn rồi. link file đính kèm đây ạ. http://www.cadviet.com/link/?f=upfiles/3/62874_drawing3_1.dwg&w=64013 . Em nghix là xem ví dụ là có thể hiểu đc rồi chứ a. Cảm ơn mọi...
>>


Em xin lỗi vì em giải thích ý tưởng của em nhưng mãi ko ai hiểu. Không biết các bác có xem file đính kèm cuối cùng của em chưa, nếu xem rồi, chỉ cần các bác giúp em làm được như ví dụ trong file đính kèm đó là em cảm ơn rồi. link file đính kèm đây ạ. http://www.cadviet.com/link/?f=upfiles/3/62874_drawing3_1.dwg&w=64013 . Em nghix là xem ví dụ là có thể hiểu đc rồi chứ a. Cảm ơn mọi người nhiều.
Còn đây là lips CV copy thông minh của em :

;COP THONG MINH
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq kytu (substr text (strlen text))
ma (ascii kytu)
sokt (read kytu)
lui 1
)
(if (numberp sokt)
(progn
(setq luusokt (1+ sokt))
(if (and (numberp sokt)
(> (strlen text) 1)
)
(progn
(setq kytu (substr text (1- (strlen text)))
sokt (read kytu)
)
(if (numberp sokt)
(setq luusokt (1+ sokt)
lui 2
)
)
);progn
)
(if (= luusokt 100) (setq luusokt 0))
(setq kytu (rtos luusokt 2 0)

text (strcat (substr text 1 (- (strlen text) lui)) kytu)
)
);progn
(if (or (= kytu "z")
(= kytu "Z")
)
(setq text (strcat text "0")
textxl "0"
)
(setq ma (1+ ma)
text (strcat (substr text 1 (1- (strlen text))) (chr ma))
)
);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq doituong (entget tendoituong)
kieu (cdr (assoc 0 doituong))
canle (cdr (assoc 72 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(progn
(setq textxl (xulytext textxl)
text (cons 1 textxl)
vitri10 (cdr (assoc 10 doituong))
vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
vitri10 (cons 10 vitri10)
vitri11 (cdr (assoc 11 doituong))
vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
vitri11 (cons 11 vitri11)
dem 0
dsach nil
)
(foreach tam doituong
(cond
((= (car tam) 1) (setq dsach (append dsach (list text))))
((= (car tam) 10) (setq dsach (append dsach (list vitri10))))
((= (car tam) 11) (setq dsach (append dsach (list vitri11))))
((setq dsach (append dsach (list tam))))
)
)
(entmake dsach)
);progn
);if
);
;sao doi tuong cu sang vi tri moi
(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun
(defun c:CV ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nXin Ngai cho con toi mot diem khac:")
thoat nil
dem 0
textxl nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while (and (= thoat nil)
(< dem dodai)
)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)

(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(setq thoat T
textxl (cdr (assoc 1 doituong))
)
)
);
(while T
(setq toi (getpoint "\nCho con toi diem khac nua di: " goc)
vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem 0
)
(while (< dem dodai)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(doitext ten)
(copy_dt ten)
);if
)
);while
(ketthuc)
)

<<

Filename: 200879_cv.lsp
Tác giả: quansla
Bài viết gốc: 200852
Tên lệnh: taodim
xin thông số tiêu chuẩn cho dim


(Defun c:taodim ()
(setvar "cmdecho"0)


(command "DIMBLK""archtick")
(command "DIMASZ"2)
(command "DIMCEN"0)
(command "DIMTIH" off)
(command "DIMTDEC" 2)
(command "DIMZIN" 8)
(command "DIMAZIN" 2)
(command "DIMTOH" "OFF")
(command "DIMTIH" "OFF")
(command "DIMEC"...
>>


(Defun c:taodim ()
(setvar "cmdecho"0)


(command "DIMBLK""archtick")
(command "DIMASZ"2)
(command "DIMCEN"0)
(command "DIMTIH" off)
(command "DIMTDEC" 2)
(command "DIMZIN" 8)
(command "DIMAZIN" 2)
(command "DIMTOH" "OFF")
(command "DIMTIH" "OFF")
(command "DIMEC" 2)

(command "DIMCLRT"256)
(command "DIMTXT"2)
(command "DIMTAD"1)
(command "DIMGAP"1)
(command "DIMCLRD" 256)
(command "DIMLTYPE""BYLAYER")
(command "DIMLWD"-1)
(command "DIMDLE"1)
(command "DIMDLI"6)


(Command "DIMCLRE"256)
(command "DIMLTEX1""BYLAYER")
(command "DIMLTEX2""BYLAYER")
(command "DIMEXE"1)
(command "DIMEXO"0)
(command "DIMLWE"-1)




(command "DIMATFIT"3)
(command "DIMTMOVE"0)
(SETVAR "DIMSCALE" 0)
(command "DIMTOFL""ON")



(command "DIMDEC"2)
(command "DIMDSEP"".")
(command "DIMLUNIT"2)


(command "DIMLWD"-1)
(command "DIMLWE"-1)

(IF (NOT (TBLSEARCH "STYLE""DIM"))
(command "-style" "DIM" "romans.shx" "" "" "" "" "" "" )
)

(COMMAND "DIMTXSTY" "DIM")


(Command ".dimstyle""s""xxxxx100")
(prompt "da tao xong dimstyle xxxxx100 dat lam hien hanh")
(setvar "cmdecho"1)

);end c:

trước mình làm list này sau thì thấy hình như cũng chưa hợp lý lắm; bạn dùng tạm xem
1. nếu mún dùng list làm tạo DIMSTYLE của MODEL sửa biến DIMSCALE về một số khác 0
2. Nếu mún sửa tên lệnh thay dòng (defun c:taodim() bằng dòng (defun c:
3. hình như mình thấy để các cặp khoảng nhô và chiều cao chữ, khoảng cách chữ đến DIM là 1, 2.5, và 1 là hơi to bạn mình vẫn thường chỉnh lại là 1(/0.8), 1.8, và 0.5 tùy bạn thôi trước mắt bạn cử nhìn vào kết quả list làm được và sửa theo ý mình là được
<<

Filename: 200852_taodim.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 200874
Tên lệnh: darp
Lisp Dim R tại Arc của LWPolyline

Hề hề hề,
Khó thật đấy. Khó nhất là phải đọc những điều ..... dở hơi ở trên bạn ạ.
Hãy thử cái này coi đã hết khó chưa ???


Bạn hãy bỏ cái kiểu nói khó nghe ở trên đi nhé nếu còn muốn có sự giúp đỡ.

Filename: 200874_darp.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 200885
Tên lệnh: ha
đo khoảng cách bằng chỉ bằng 1 lần rê chuột

Tiện hơn nữa là chỉ cần chọn cả Line và Text chỉ 1 lần. Tuy nhiên, như bác PTB góp ý, là tôi chỉ viết theo ý tưởng đoán mò từ hình vẽ của bạn nhé.

Filename: 200885_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 200813
Tên lệnh: h1

Bạn down về dùng xem. Tôi dùng trên bản vẽ của bạn vẫn OK.

Filename: 200813_h1.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 200891
Tên lệnh: ha
Nhờ các bác giúp em lips thực hiện hàm lặp.

Tôi không sử dụng lisp "copy thông minh" của bạn, mà viết mới cho bạn đây.
Lisp này chấp nhận text có tiền và/hoặc hậu tố luôn.

Filename: 200891_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 200969
Tên lệnh: vg dse 12 dd1 tc
thêm giúp mình text cho lisp tính diện tích
Đây bạn!

Filename: 200969_vg_dse_12_dd1_tc.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 200987
Tên lệnh: 1
gộp giúp em lisp lệnh bật, tắt Layer với
Lisp gộp 2 lệnh LAYOFF và LAYON thành 1 lệnh.

Filename: 200987_1.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 50890
Tên lệnh: gocdoc
Viết Lisp theo yêu cầu


Chào bạn sucuph,
Lisp đầy đủ đây ạ:


Bạn lưu ý là khi lisp yêu cầu bạn chọn mái doc thì bạn phải chọn vào đúng mái dốc cần xác định độ dốc chứ không được nhấn enter ngay nha.
Khi góc dốc >pi/2 bạn sẽ thấy text bị lộn ngược và tùy theo ý bạn có thể để nguyên hay rotate nó nhé.
Bạn lưu ý thêm là mình có thay đổi cái cách xác định góc xoay...
>>


Chào bạn sucuph,
Lisp đầy đủ đây ạ:


Bạn lưu ý là khi lisp yêu cầu bạn chọn mái doc thì bạn phải chọn vào đúng mái dốc cần xác định độ dốc chứ không được nhấn enter ngay nha.
Khi góc dốc >pi/2 bạn sẽ thấy text bị lộn ngược và tùy theo ý bạn có thể để nguyên hay rotate nó nhé.
Bạn lưu ý thêm là mình có thay đổi cái cách xác định góc xoay của text do hàm angle trả ra giá trị theo radian mà lệnh text yêu cầu nhập giá trị theo độ.
Trong trường hợp mái dốc của bạn không phải là đường line thì góc ang sẽ là góc của điểm đầu và điểm cuối của đường polyline hay spline đó bạn nhé.
Mình đã chạy thử lisp ngon.

Chúc bạn vui và thành công.
<<

Filename: 50890_gocdoc.lsp

Trang 91/301

91