Nếu cứ theo yêu cầu ở trên thì bác dùng list này, kiểm tra lại bác nhé
Tên lệnh "THU"
cách dùng
B1, chọn "LINE" (chỉ "LINE" thôi nhé, không thể chọn được cái gì khác LINE <nếu cần em sẽ viết để bác có thể "EXPLORE" phá Polyline trước ra nhưng trước mắt cứ hạn chế quyền này đã)
B2, chọn Text là số (nói là Text, thực ra bác chỉ cần...

Nếu cứ theo yêu cầu ở trên thì bác dùng list này, kiểm tra lại bác nhé
Tên lệnh "THU"
cách dùng
B1, chọn "LINE" (chỉ "LINE" thôi nhé, không thể chọn được cái gì khác LINE <nếu cần em sẽ viết để bác có thể "EXPLORE" phá Polyline trước ra nhưng trước mắt cứ hạn chế quyền này đã)
B2, chọn Text là số (nói là Text, thực ra bác chỉ cần chọn bất cứ cái gì có mã DXF là 1 là được, nếu hiểu CODE list, thì trong CODE em quy định như sau: Xuất phát từ tư tưởng(chỉ chọn Text có sẵn, hoặc DIM có sẵn (fake hoặc chưa fake) bọn này đều có mã DXF 1) khi đó nếu là Text thì lấy bình thường giá trị là hàm (atof (cdr(assoc 1 ..))) nếu là DIM thì kiểm tra nếu DIM là DIM chưa fake thì lấy giá trị của mã DXF 42, nếu là DIM đã FAKE thì nếu có giá trị số thì lấy, nếu giá trị là TEXT thì bỏ qua dùng mã DXF 42)
Đến đây sẽ có thông báo về tỷ lệ đọc được
B3 quét chọn các DIM cần thay đổi (vấn đề là theo bài bác nói trước, bản vẽ của bác vẽ từ soft ngoài thì làm gì có DIM nhỉ) lisp tự tính toán sửa lại các giá trị DIM
*error* lisp của em hiện nay chưa hoàn thiện, chưa cho phép khi ấn ESC sẽ khôi phục lại như trước khi dùng lisp, cái này để em xem lại sau.
Bác dùng và kiểm tra nhé


(defun c:thu ()
;;-----
(defun xuly_nhaptay (a1 / b1_user)
(setq b1_user (getreal "\nNhap chieu dai mong muon"))
( / a1 b1_user )
)
;;-----
(defun xuly_picktext (a1 Tex / b1)
(If (= (type (atof(cdr(assoc 1 (entget(car Tex))))) ) (type 3.4))
(progn
(if (/= "" (cdr(assoc 1 (entget(car Tex)))))
(setq b1 (atof(cdr(assoc 1 (entget(car Tex))))))
(setq b1 (cdr(assoc 42 (entget(car Tex))))) )
)
)
(if b1
( / a1 b1 )
;(xuly_nhaptay)
)
)
;;-----
(defun xuly_yeucau_pI_xdtyle( / dt ent_dt a1)
(while (or (null dt)
(/= "LINE" (cdr (assoc 0 (entget (car dt))))) )
(setq dt (entsel"\nChon LINE")))
(setq ent_dt (entget (car dt)))
(setq a1 (distance (cdr(assoc 10 ent_dt)) (cdr(assoc 11 ent_dt)) ))
;;chon text chua gia tri fake dim hoac nhap tay
(if (setq picktext (entsel "\nPick chon Text la so"))
(setq ##tyle## (xuly_picktext a1 picktext))
(setq ##tyle## (xuly_nhaptay a1))
)
(princ (strcat "Tyle ban ve hien xac dinh duoc la : " (rtos ##tyle## 2 5 ) "\n"))
(princ)
)
;;-----
(defun xuly_yeucau_PII ( / ss i entdt_ss a2 giatri_new)
(prompt "\nChon cac duong DIM de converst")
(princ)
(setq ss (ssget (list (cons 0 "DIMENSION"))))
(setq i -1)
(repeat (sslength ss)
(command "undo" "begin")
(setq i (1+ i))
(setq entdt_ss (entget(ssname ss i)))
(princ)
;;xac dinh gia tri thuc a2 cua dim
(setq a2 (distance (cdr(assoc 13 entdt_ss)) (cdr(assoc 14 entdt_ss)) ))
;; ket thuc a2 xac dinh gia tri moi bang a2/x (x la tyle o phan I)
(setq giatri_new (rtos (/ a2 ##tyle##)))
(setq entdt_ss (subst (cons 1 giatri_new) (assoc 1 entdt_ss) entdt_ss))
(if ( = (atof(cdr(assoc 1 entdt_ss)))
(cdr(assoc 42 entdt_ss))
)
(setq entdt_ss (subst (cons 1 "") (assoc 1 entdt_ss) entdt_ss))
nil
)
(entmod entdt_ss)
(command "undo" "end")
);end_repeat
)
;;CHUONG TRINH CHINH
(setvar "cmdecho" 0)
(xuly_yeucau_pI_xdtyle)
(xuly_yeucau_PII)
(setvar "cmdecho" 1)
(princ (strcat "Tyle ban ve hien xac dinh duoc la : " (rtos ##tyle## 2 5 ) "\n"))
(princ)
)

Hix, học hành bét nhé như e chưa ra được anh ạ, mấy hôm tiếp thì lại bận rồi, còn list thử của em mỗi yêu cầu, bác bỏ ra làm lệnh đều được mà,

;;cac ham con
;;-----
(defun xuly_nhaptay (a1 / b1_user)
(setq b1_user (getreal "\nNhap chieu dai mong muon"))
( / a1 b1_user )
)
;;-----
(defun xuly_picktext (a1 Tex / b1)
(If (= (type (atof(cdr(assoc 1 (entget(car...

Hix, học hành bét nhé như e chưa ra được anh ạ, mấy hôm tiếp thì lại bận rồi, còn list thử của em mỗi yêu cầu, bác bỏ ra làm lệnh đều được mà,

;;cac ham con
;;-----
(defun xuly_nhaptay (a1 / b1_user)
(setq b1_user (getreal "\nNhap chieu dai mong muon"))
( / a1 b1_user )
)
;;-----
(defun xuly_picktext (a1 Tex / b1)
(If (= (type (atof(cdr(assoc 1 (entget(car Tex))))) ) (type 3.4))
(progn
(if (/= "" (cdr(assoc 1 (entget(car Tex)))))
(setq b1 (atof(cdr(assoc 1 (entget(car Tex))))))
(setq b1 (cdr(assoc 42 (entget(car Tex))))) )
)
)
(if b1
( / a1 b1 )
;(xuly_nhaptay)
)
)
;;-----
(defun xuly_yeucau_pI_xdtyle( / dt ent_dt a1)
(while (or (null dt)
(/= "LINE" (cdr (assoc 0 (entget (car dt))))) )
(setq dt (entsel"\nChon LINE")))
(setq ent_dt (entget (car dt)))
(setq a1 (distance (cdr(assoc 10 ent_dt)) (cdr(assoc 11 ent_dt)) ))
;;chon text chua gia tri fake dim hoac nhap tay
(if (setq picktext (entsel "\nPick chon Text la so"))
(setq ##tyle## (xuly_picktext a1 picktext))
(setq ##tyle## (xuly_nhaptay a1))
)
(princ (strcat "Tyle ban ve hien xac dinh duoc la : " (rtos ##tyle## 2 5 ) "\n"))
(princ)
)
;;-----
;;-----
(defun xuly_yeucau_PII ( / ss i entdt_ss a2 giatri_new)
(prompt "\nChon cac duong DIM de converst")
(princ)
(setq ss (ssget (list (cons 0 "DIMENSION"))))
(setq i -1)
(repeat (sslength ss)
(command "undo" "begin")
(setq i (1+ i))
(setq entdt_ss (entget(ssname ss i)))
(princ)
;;xac dinh gia tri thuc a2 cua dim
(setq a2 (distance (cdr(assoc 13 entdt_ss)) (cdr(assoc 14 entdt_ss)) ))
;; ket thuc a2 xac dinh gia tri moi bang a2/x (x la tyle o phan I)
(setq giatri_new (rtos (/ a2 ##tyle##)))
(entmod (subst (cons 1 giatri_new) (assoc 1 entdt_ss) entdt_ss))
(command "undo" "end")
);end_repeat
)
;;CHUONG TRINH CHINH
(defun c:thu1 ()
(xuly_yeucau_pI_xdtyle)
)
(defun c:thu2 ()
(setvar "cmdecho" 0)
;(xuly_yeucau_pI_xdtyle)
(xuly_yeucau_PII)
(setvar "cmdecho" 1)
(princ (strcat "Tyle ban ve hien xac dinh duoc la : " (rtos ##tyle## 2 5 ) "\n"))
(princ)
)

List của bác em trước xem rồi, nhưng mà đã nói bác up file bác không up thì em chịu hông viết được, bác up file lên đi
Mấu chốt là các DIM của bác đã bị Scale thì mỗi dim ở tỷ lệ khác nhau có Arrow khác nhau mà đúng không

LISP của bạn bị lỗi khi dùng lệnh chprop kết hợp với chọn đối tượng bằng ssget "X".
Thực ra lệnh chprop chỉ cho phép chọn đối tượng trên TAB (Model hay Layout) hiện hành.
trong khi đó (ssget "X" (list (cons 8 "Plinetntn"))) sẽ trả về các đối tượng trên toàn bộ TAB(Model, catdoc, catngang,...) thuộc lớp Plinetntn -> lệnh chprop bị lỗi.

Cách khắc phục...

LISP của bạn bị lỗi khi dùng lệnh chprop kết hợp với chọn đối tượng bằng ssget "X".
Thực ra lệnh chprop chỉ cho phép chọn đối tượng trên TAB (Model hay Layout) hiện hành.
trong khi đó (ssget "X" (list (cons 8 "Plinetntn"))) sẽ trả về các đối tượng trên toàn bộ TAB(Model, catdoc, catngang,...) thuộc lớp Plinetntn -> lệnh chprop bị lỗi.

Cách khắc phục :
1.Chỉ chọn đối tượng trên TAB (Model hay Layout) hiện hành thuộc lớp Plinetntn
(ssget "X" (list (cons 410 (getvar "ctab"))(cons 8 "Plinetntn")))
Cách này có nhược điểm là phải thực hiện LISP lần lượt trên từng TAB(Model, catdoc, catngang,...) nhưng dễ kiểm soát hơn.

2.Vẫn sử dụng (ssget "X" (list (cons 8 "Plinetntn"))) để chọn các đối tượng trên toàn bộ TAB(Model, catdoc, catngang,...) thuộc lớp Plinetntn, sau đó dùng hàm EntMod để cập nhật Database cho các đối tượng này.
Ưu điểm là chỉ cần chạy LISP một lần (nhanh gọn) nhưng theo ý tui thì khó kiểm soát (không an toàn), bạn thử viết theo hướng này nhé.

Ngoài ra trong LISP của bạn có dòng lệnh :
(Command "layer" "m" "Plinetntn" "L" "Hidden2" "" "")
-> thay đổi Linetype của lớp Plinetntn thành Hidden2.
Điều này chỉ có tác dụng khi các đối tượng trên lớp Plinetntn được Set ở ByLayer.

Một thắc mắc nhỏ : Thông thường User vẽ các đối tượng trên Model sau đó dùng Layout để xuất bản vẽ (ploting) theo tỉ lệ mong muốn. Bản vẽ của bạn lại thực hiện trên Layout.

Hy vọng Lisp này đúng nhu cầu của bạn.

Không cần phải là những đoạn code quá cao siêu, chỉ cần 1 vài đoạn code nhỏ, đơn giản để thay đổi cách thức làm việc các lệnh cơ bản của cad có thê khiến tốc độ vẽ của bạn tăng lên rất nhiều bởi đó là các lệnh chúng ta phải sử dụng thường xuyên. Mình lập topic này hi vọng mọi người cùng đóng góp ý tưởng. Khi không hài lòng với lệnh nào đó, thấy nó rườm rà 1 bước nào...

Không cần phải là những đoạn code quá cao siêu, chỉ cần 1 vài đoạn code nhỏ, đơn giản để thay đổi cách thức làm việc các lệnh cơ bản của cad có thê khiến tốc độ vẽ của bạn tăng lên rất nhiều bởi đó là các lệnh chúng ta phải sử dụng thường xuyên. Mình lập topic này hi vọng mọi người cùng đóng góp ý tưởng. Khi không hài lòng với lệnh nào đó, thấy nó rườm rà 1 bước nào đó, có thể bỏ qua 1 bước nào đó hoặc thêm 1 bước nào đó để nó dễ dàng hơn cho quá trình vẽ thì post vào đây.
Topic này mình không thuộc mấy thể loại nên không đặt tiền tố. Nhờ mod phụ trách box lisp đặt lại cho thích hợp dùm mình. Cảm ơn mod! Mình là kẻ khai mào nên đi trước:

1. chúng ta thường phải chọn bằng phím P (Previous) khi con trỏ đang ở chế độ chọn đối tượng cho lệnh hiện hành. hơi bất tiện vì phím P ở khá xa tay trái. Mình chuyển nó về phím space luôn cho các lệnh cơ bản: Copy, move, rotate, stretch, scale, miror, draw order. Khi sử dụng các lệnh này, sau khi gõ lệnh bạn chỉ cần nhấn space thêm 1 lần là chọn được các đối tượng trước luôn.
;;; Copy
(defun C:C (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Copy" SS "" "M")
(vl-cmdf "Copy" "P" "" "M"))
(princ))

;;; Move
(defun C:M (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Move" SS "")
(vl-cmdf "Move" "P" ""))
(princ))

;;; Rotate
(defun C:R (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Rotate" SS "")
(vl-cmdf "Rotate" "P" ""))
(princ))

;;; Stretch
(defun C:S (/ SS)
(if (setq SS (ssget))
(vl-cmdf "STRETCH" SS "")
(vl-cmdf "STRETCH" "P" ""))
(princ))

;;; Scale
(defun C:SC (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Scale" SS "")
(vl-cmdf "Scale" "P" ""))
(princ))

;;; Miror
(defun C:Mi (/ SS)
(if (setq SS (ssget))
(vl-cmdf "mirror" SS "")
(vl-cmdf "mirror" "P" ""))
(princ))

;;; DrawOrder
(defun C:DR (/ SS)
(if (setq SS (ssget))
(vl-cmdf "DRAWORDER" SS "")
(vl-cmdf "DRAWORDER" "P" ""))
(princ))

2. Nhưng nếu bạn muốn chọn tập hợp Previuos trước cho 1 lênh nào khác mấy lệnh trên thì sao. Bạn có thể dùng lệnh này:
(defun C:SS (/ ss)
(or
(not (equal '(nil nil) (sssetfirst nil (ssget "p"))))
(prompt " ** Khong co doi tuong nao duoc chon **"))
(princ))

Không cần phải là những đoạn code quá cao siêu, chỉ cần 1 vài đoạn code nhỏ, đơn giản để thay đổi cách thức làm việc các lệnh cơ bản của cad có thê khiến tốc độ vẽ của bạn tăng lên rất nhiều bởi đó là các lệnh chúng ta phải sử dụng thường xuyên. Mình lập topic này hi vọng mọi người cùng đóng góp ý tưởng. Khi không hài lòng với lệnh nào đó, thấy nó rườm rà 1 bước nào...

Không cần phải là những đoạn code quá cao siêu, chỉ cần 1 vài đoạn code nhỏ, đơn giản để thay đổi cách thức làm việc các lệnh cơ bản của cad có thê khiến tốc độ vẽ của bạn tăng lên rất nhiều bởi đó là các lệnh chúng ta phải sử dụng thường xuyên. Mình lập topic này hi vọng mọi người cùng đóng góp ý tưởng. Khi không hài lòng với lệnh nào đó, thấy nó rườm rà 1 bước nào đó, có thể bỏ qua 1 bước nào đó hoặc thêm 1 bước nào đó để nó dễ dàng hơn cho quá trình vẽ thì post vào đây.
Topic này mình không thuộc mấy thể loại nên không đặt tiền tố. Nhờ mod phụ trách box lisp đặt lại cho thích hợp dùm mình. Cảm ơn mod! Mình là kẻ khai mào nên đi trước:

1. chúng ta thường phải chọn bằng phím P (Previous) khi con trỏ đang ở chế độ chọn đối tượng cho lệnh hiện hành. hơi bất tiện vì phím P ở khá xa tay trái. Mình chuyển nó về phím space luôn cho các lệnh cơ bản: Copy, move, rotate, stretch, scale, miror, draw order. Khi sử dụng các lệnh này, sau khi gõ lệnh bạn chỉ cần nhấn space thêm 1 lần là chọn được các đối tượng trước luôn.
;;; Copy
(defun C:C (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Copy" SS "" "M")
(vl-cmdf "Copy" "P" "" "M"))
(princ))

;;; Move
(defun C:M (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Move" SS "")
(vl-cmdf "Move" "P" ""))
(princ))

;;; Rotate
(defun C:R (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Rotate" SS "")
(vl-cmdf "Rotate" "P" ""))
(princ))

;;; Stretch
(defun C:S (/ SS)
(if (setq SS (ssget))
(vl-cmdf "STRETCH" SS "")
(vl-cmdf "STRETCH" "P" ""))
(princ))

;;; Scale
(defun C:SC (/ SS)
(if (setq SS (ssget))
(vl-cmdf "Scale" SS "")
(vl-cmdf "Scale" "P" ""))
(princ))

;;; Miror
(defun C:Mi (/ SS)
(if (setq SS (ssget))
(vl-cmdf "mirror" SS "")
(vl-cmdf "mirror" "P" ""))
(princ))

;;; DrawOrder
(defun C:DR (/ SS)
(if (setq SS (ssget))
(vl-cmdf "DRAWORDER" SS "")
(vl-cmdf "DRAWORDER" "P" ""))
(princ))

2. Nhưng nếu bạn muốn chọn tập hợp Previuos trước cho 1 lênh nào khác mấy lệnh trên thì sao. Bạn có thể dùng lệnh này:
(defun C:SS (/ ss)
(or
(not (equal '(nil nil) (sssetfirst nil (ssget "p"))))
(prompt " ** Khong co doi tuong nao duoc chon **"))
(princ))

Bạn kiểm tra lại với lisp này nhé !
Mình check ok mà

(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
...

Bạn kiểm tra lại với lisp này nhé !
Mình check ok mà

(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
(defun C:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
(setq tot_len 0.0)
(setq ss (ssget))
(setq len (sslength ss))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(setq tot_len (* k tot_len))
(setq tbinh (/ tot_len len))
;--------------------------------------------
(setq Kieu (strcase (getstring "\nGhi ra Text co san <Co>/Khong: ")))
(Cond
((/= Kieu "K")
(setq elst (entget (car (entsel "\n Thay cho so: "))))
(setq elst (subst (cons 1 (rtos tbinh 2 2)) (assoc 1 elst) elst))
;; doan ma lisp chuyen mau ket qua tinh
(if (assoc 62 elst)
(setq elst (subst (cons 62 80) (assoc 62 elst) elst))
(setq elst (append elst (list (cons 62 80))))
)
(entmod elst)
(princ)
)
((= Kieu "K")
;--------------------------------------------
(setq point (getpoint "\n Chon diem ghi ket qua: "))
(setq th (getvar "textsize"))
(setq th (getstring (strcat "\nChieu cao chu <"(rtos th)"> :")))
(command "TEXT" point th 0 (rtos tbinh 2 2))
(alert (strcat "Chieu dai trung binh cac doan vua chon: "(rtos tbinh 2 2)))
;---------------------------------------------
)
)
(princ)
)

Lệnh: tb nếu chọn ghi ra text có sẵn: bỏ qua là có, nếu không ghi K

Cái chọn K máy bạn không được, mình không rõ lắm vì máy mình ok (Bạn thử kiểm tra lại chế độ bắt điểm)
bạn thử xem

(prompt "command : dai")
(defun c:dai()
(setq tong 0)
(setq th (ssget))
(setq index 0)
(setq dtuong (sslength th))
(while (< index dtuong)
(setq ds (entget (ssname th index)))

(command "lengthen" (ssname th index) "" )
(setq...

Cái chọn K máy bạn không được, mình không rõ lắm vì máy mình ok (Bạn thử kiểm tra lại chế độ bắt điểm)
bạn thử xem

(prompt "command : dai")
(defun c:dai()
(setq tong 0)
(setq th (ssget))
(setq index 0)
(setq dtuong (sslength th))
(while (< index dtuong)
(setq ds (entget (ssname th index)))

(command "lengthen" (ssname th index) "" )
(setq tong (+ tong (getvar "perimeter")))

(setq index (1+ index))
)
(print tong)
(prompt "Ghi text moi <G> hay thay the text (T) :")
(setq luachon (getstring))
(setq luachon (strcase luachon))
(if (= "" luachon) (setq luachon "G"))
(if (= "G" luachon)
(progn
(setq pt1 (getpoint))
(setq h (/ (getvar "viewsize") 20))
(command "text" pt1 h "" tong)
)
)
(if (= "T" luachon)
(progn
(prompt "\n Chon gia tri can thay the")
(SETQ TT (SSGET))
(setq s (entget (SSNAME TT 0)))
(setq otext (assoc 1 s))
(setq ot (cdr otext))
(setq ot (read (substr ot 1 )))
(setq nt (cons 1 (rtos tong 2)))
;(setq s (subst nt otext s))
(setq s (subst (cons 62 80) (assoc 62 s) s))
(setq s (append s (list (cons 62 80))))
(entmod s)
(princ)
)
)
)

Tôi chỉ sửa qua được vậy thôi
Cái số 80 là mầu, bạn thích mầu nào thay số 80=màu (1...256)

1) Theo đánh giá chủ quan của mình (và theo số liệu thống kê trong 1 tài liệu mà mình đã từng đọc ở đâu đó trong 4r này) thì chúng ta thường dùng Esc để thoát lệnh nhiều hơn dùng Space rất nhiều. Dùng Esc gần như là phản xạ vô thức bạn ạ. sau khi mình dùng phương pháp trên 1 thời gian thì thấy tốc độ vẽ tăng lên rất nhiều. bạn cứ thử xem thế nào nhé.
2) về tên lệnh: vì đây là...

1) Theo đánh giá chủ quan của mình (và theo số liệu thống kê trong 1 tài liệu mà mình đã từng đọc ở đâu đó trong 4r này) thì chúng ta thường dùng Esc để thoát lệnh nhiều hơn dùng Space rất nhiều. Dùng Esc gần như là phản xạ vô thức bạn ạ. sau khi mình dùng phương pháp trên 1 thời gian thì thấy tốc độ vẽ tăng lên rất nhiều. bạn cứ thử xem thế nào nhé.
2) về tên lệnh: vì đây là các lệnh cơ bản mà chúng ta sử dụng với mật độ thường xuyên nhất nên mình ưu tiên chuyển về các phím dễ gõ, đa số mọi người đều vậy mà. Mượn thì phải trả, bạn có thể đổi các lệnh bị lấy sang lệnh khác (ví dụ: rt = rotate, cx = Circle...) nếu không quen thì có thể tùy biến cho phù hợp với nhu cầu mỗi người. Điều mà mình muốn nhấn mạnh ở topic này là ý tưởng cải tạo lệnh cad chứ không nặng nề cái tên lệnh như thế nào bạn ạ.
---------------------------------------------------
Mình tiếp tục nhé. Lệnh J (Join) đưa ra phương pháp chọn đối tượng không được tối ưu cho lắm. Thứ tự chọn của nó: đầu tiên chọn đối tượng gốc rồi sau đó mới chọn lần lượt các đối tượng muốn join với nó. mất 2 lần select đối tượng và mỗi lần gõ lệnh chỉ tạo ra được 1 đối tượng cuối. mình cải tạo nó thế này: gõ lệnh và chọn tập hợp muốn join với nhau luôn. các đối tượng nào có thể join được với nhau sẽ tự join. Cái này gọi là Join hàng loạt ^^

(defun c:j (/ en lst ss n)
(and
(setq n 0 ss (ssget))
(while (< n (sslength ss))
(setq en (ssname ss n) n (1+ n))
(vl-cmdf "join" en ss "")))
(princ))

Nếu sử dụng lệnh này cho các bản vẽ bị phá khối nát thành các line sẽ thấy cực kỳ hiệu quả. nhất là các bản vẽ bình đồ đường đồng mức bị phá

;---------Tinh Dien Tich Dao, Dap (Cho M.cat) - C:Dien_tich
;**********************************************************
(defun Get_tle (/ g:tld)
(set_tile "error" "")
(setq g:tle (get_tile "tle"))
(setq tle (atof g:tle))
)
;------------------------------------------
(defun Get_ten (/ g:ten)
(set_tile "error" "")
(setq g:ten (get_tile "ten"))
(setq ten...

;---------Tinh Dien Tich Dao, Dap (Cho M.cat) - C:Dien_tich
;**********************************************************
(defun Get_tle (/ g:tld)
(set_tile "error" "")
(setq g:tle (get_tile "tle"))
(setq tle (atof g:tle))
)
;------------------------------------------
(defun Get_ten (/ g:ten)
(set_tile "error" "")
(setq g:ten (get_tile "ten"))
(setq ten g:ten)
)
;------------------------------------------
(defun Get_cdon (/ g:cdon)
(set_tile "error" "")
(setq g:cdon (get_tile "cdon"))
(setq cdon (atof g:cdon))
)
;------------------------------------------
;------------------------------------------
;------------------------------------------
(defun Get_boc (/ g:boc)
(set_tile "error" "")
(setq g:boc (get_tile "boc"))
(setq boc g:boc)
(cond
((= g:boc "1")
(mode_tile "eboc" 0)
(mode_tile "pboc" 0)
)
(T
(mode_tile "eboc" 1)
(mode_tile "pboc" 1)
)
)
)
;------------------------------------------
(defun Get_dao (/ g:dao)
(set_tile "error" "")
(setq g:dao (get_tile "dao"))
(setq dao g:dao)
(cond
((= g:dao "1")
(mode_tile "edao" 0)
(mode_tile "pdao" 0)
)
(T
(mode_tile "edao" 1)
(mode_tile "pdao" 1)
)
)
)
;------------------------------------------
(defun Get_dap (/ g:dap)
(set_tile "error" "")
(setq g:dap (get_tile "dap"))
(setq dap g:dap)
(cond
((= g:dap "1")
(mode_tile "edap" 0)
(mode_tile "pdap" 0)
)
(T
(mode_tile "edap" 1)
(mode_tile "pdap" 1)
)
)
)
;------------------------------------------
;------------------------------------------
;------------------------------------------
(defun Get_eboc (/ g:eboc)
(set_tile "error" "")
(setq g:eboc (get_tile "eboc"))
(setq eboc (atof g:eboc))
)
;------------------------------------------
(defun Get_edao (/ g:edao)
(set_tile "error" "")
(setq g:edao (get_tile "edao"))
(setq edao (atof g:edao))
)
;------------------------------------------
(defun Get_edap (/ g:edap)
(set_tile "error" "")
(setq g:edap (get_tile "edap"))
(setq edap (atof g:edap))
)
;------------------------------------------
;------------------------------------------
;------------------------------------------
(defun Get_pboc ()
(set_tile "error" "")
(Dientich)
(set_tile "eboc" (rtos Sdo 2 3))
)
;------------------------------------------
(defun Get_pdao ()
(set_tile "error" "")
(Dientich)
(set_tile "edao" (rtos Sdo 2 3))
)
;------------------------------------------
(defun Get_pdap ()
(set_tile "error" "")
(Dientich)
(set_tile "edap" (rtos Sdo 2 3))
)
;------------------------------------------
;------------------------------------------
;------------------------------------------
(defun Setloc()
(if (not tle) (setq tle 50.0))
(set_tile "tle" (setq g:tle (rtos tle 2 0)))
(if (not ten) (setq ten "A-A"))
(set_tile "ten" (setq g:ten ten))
(if (not cdon) (setq cdon 0.0))
(set_tile "cdon" (setq g:cdon (rtos cdon 2 2)))

)
;------------------------------------------
(defun Restore()
(command "LUPREC" 2 "color" "bylayer" "osmode" 97 "zoom" "E")
(setq *ERROR* Olderr)
(setvar "BLIPMODE" Oldblp) (setvar "CMDECHO" Oldech)
(setvar "PICKBOX" 4) (setvar "DIMZIN" 8)
)
;-------------------------------------------------------------------------
(defun C:Dien_tich (/ Oldblp Oldech Olderr Dial nhim What_next ten cdon)
(if (not (setq nhim (Acdd 70))) (progn (alert "Kh&#171;ng th&#211; ti&#213;p t&#244;c...") (exit)))
(setq Oldblp (getvar "BLIPMODE") Oldech (getvar "CMDECHO") Olderr *ERROR*)
(setvar "BLIPMODE" 0) (setvar "DIMZIN" 0) (setvar "PICKBOX" 0) (setvar "CMDECHO" 0)
(COMMAND "LUPREC" 8 "osnap" "None" "UCS" "W")
;----------------------------------------------
(defun *ERROR* (Msg)
(princ "\nError: ") (princ Msg)
(unload_dialog Dial)
(Restore)
(princ)
)
;--------------------------------------------
(setq Dial (load_dialog "Dien_tich.DCL"))
(setq What_next 2)
(while (> What_next 1)
(if (not (new_dialog "Dientich" Dial))
(progn (Restore) (exit))
)
(Setloc)
(action_tile "tle" "(Get_tle)")
(action_tile "ten" "(Get_ten)")
(action_tile "cdon" "(Get_cdon)")
(action_tile "boc" "(Get_boc)")
(action_tile "dao" "(Get_dao)")
(action_tile "dap" "(Get_dap)")
; (action_tile "eboc" "(Get_eboc)")
; (action_tile "edao" "(Get_edao)")
; (action_tile "edap" "(Get_edap)")
(action_tile "pboc" "(Get_pboc)")
(action_tile "pdao" "(Get_pdao)")
(action_tile "pdap" "(Get_pdap)")
(action_tile "Accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq What_next (start_dialog))
(if (= What_next 1) (Go))
)
(unload_dialog Dial)
(Restore)
(princ)
)
;;;-------------------------------------------------------------------
(defun dientich ( / bli cmd E Eo En do diem s name Ename oldcolor)
(setq bli (getvar "BLIPMODE") oldcolor (getvar "cecolor") cmd (getvar "CMDECHO"))
(setvar "BLIPMODE" 1) (setvar "CMDECHO" 0) (COMMAND "LUPREC" 4)
(setq dao nil s nil Sdao nil Ename (ssadd))
(setq E "P") (initget 128 "P S")
(setq Eo (getkword "\nSelect Entity or Pick Point (S/<P>) : "))
(if Eo (setq E Eo))
(cond
((= E "P")
(command "color" 6 "linetype" "S" "hidden" "" "osmode" 0)
(while
(setq diem (getpoint "\n Pick point...(<Retern>to end) :"))
(command "boundary" diem "" "area" "E" "L")
(setq s (getvar "area"))
(setq name (entlast))
(setq do (cons s do))
(setq Ename (ssadd name Ename))
)
(setq Sdo (eval (cons + do)))
(command "erase" Ename "" "color" oldcolor "linetype" "S" "continuous" "")
)
(T
(setq En (ssget))
(command "area" "E" En)
(setq Sdao (getvar "area"))
)
)
(setq tile (/ tle 100) Sdo (* Sdo tile tile))
)
;;;-------------------------------------------
(defun Go ()
(SETQ P (GETPOINT "\nStart point...: "))
(command "text" p "0" (strcat "S = " (rtos Sboc 2 3) " (m2)")
"" (strcat "S = " (rtos Sdao 2 3) " (m2)")
"" (strcat "S = " (rtos Sdap 2 3) " (m2)"))
(COMMAND "LUPREC" 4 "osmode" 33 "linetype" "S" "Continuous" "")
(setvar "BLIPMODE" bli) (setvar "CMDECHO" cmd)
)

Mình có viết một lsp tính diện tích đào đắp có sử dụng hộp thoại
với ý tưởng có thể chọn hạng mục để tính (Chọn một trong 3 loại bóc, dào, đắp)...
- Khi chọn hạng mục xong thì Pick diện tich trên CAD, khi pick xong thì lại quay vê hộp thoại
- chọn và pick cho hạng mục khác (kết quả trả ra Edit_box trên hộp thoại.
- khi hoàn thành chọn mục và pick, nhấn OK thì ghi các kết quả chọn ra màn hình.
Nhờ mọi người sửa giúp lisp cho mình với (khi pick để đo diện tích thì CAD bị treo luôn phải tắt mới thoát được...)
File lsp và DCL theo link sau: http://www.cadviet.com/upfiles/3/88193_dientich.rar
Xin cám ơn trước !

w1nDream không có gì khó đâu, mình cũng sửa lisp thôi mà, cái yêu cầu của bạn giống lisp tb hôm qua, bạn dựa vào đó sửa nhé
Mạo phép anh em tôi sửa như sau
Như vậy sự khác nhau ở đây:
;(alert (rtos S 2 0)) - Bo cai này
(Luachon S) - Them hàm này vào
Như vậy các lần sau bạn copy hàm Luachon vào lisp vào chỗ nào có kết quả thì hàm là:
(Luachon kq)

(defun c:congdim(/ S)

>>

w1nDream không có gì khó đâu, mình cũng sửa lisp thôi mà, cái yêu cầu của bạn giống lisp tb hôm qua, bạn dựa vào đó sửa nhé
Mạo phép anh em tôi sửa như sau
Như vậy sự khác nhau ở đây:
;(alert (rtos S 2 0)) - Bo cai này
(Luachon S) - Them hàm này vào
Như vậy các lần sau bạn copy hàm Luachon vào lisp vào chỗ nào có kết quả thì hàm là:
(Luachon kq)

(defun c:congdim(/ S)
(setq S 0)
(foreach x (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
(setq S (+ S (cdr(assoc 42 (entget x)))))
)
;(alert (rtos S 2 0))
(Luachon S)
(princ))
;Doan ma lua chon ghi ket qua
(defun Luachon(tbinh)
(setq Kieu (strcase (getstring "\nGhi ra Text co san <Co>/Khong: ")))
(Cond
((/= Kieu "K")
(setq elst (entget (car (entsel "\n Thay cho so: "))))
(setq elst (subst (cons 1 (rtos tbinh 2 2)) (assoc 1 elst) elst))
;; doan ma lisp chuyen mau ket qua tinh
(if (assoc 62 elst)
(setq elst (subst (cons 62 80) (assoc 62 elst) elst))
(setq elst (append elst (list (cons 62 80))))
)
(entmod elst)
(princ)
)
((= Kieu "K")
;--------------------------------------------
(setq point (getpoint "\n Chon diem ghi ket qua: "))
(setq th (getvar "textsize"))
(setq th (getstring (strcat "\nChieu cao chu <"(rtos th)"> :")))
(command "TEXT" point th 0 (rtos tbinh 2 2))
;(alert (strcat "Chieu dai trung binh cac doan vua chon: "(rtos tbinh 2 2)))
;---------------------------------------------
)
)
)

Hài, chậm chân sau bác Hà rồi, hì . Thôi chẳng lẽ viết ra lại để không úp đại vậy
lệnh là THU (thử)

(defun c:thu(/ A B e i j)
(vl-load-com)
(alert "\nchon point nhom A")(princ)
(setq a (list) b (list))
(foreach e
(acet-ss-to-list
(ssget (list (cons 0 "POINT"))))
(setq A (append A (list(cdr(assoc 10 (entget e)))))))
(alert "\nchon point nhom...

Hài, chậm chân sau bác Hà rồi, hì . Thôi chẳng lẽ viết ra lại để không úp đại vậy
lệnh là THU (thử)

(defun c:thu(/ A B e i j)
(vl-load-com)
(alert "\nchon point nhom A")(princ)
(setq a (list) b (list))
(foreach e
(acet-ss-to-list
(ssget (list (cons 0 "POINT"))))
(setq A (append A (list(cdr(assoc 10 (entget e)))))))
(alert "\nchon point nhom B")(princ)
(foreach e
(acet-ss-to-list
(ssget (list (cons 0 "POINT"))))
(setq B (append B (list(cdr(assoc 10 (entget e)))))))
(princ "\nNoi cac diem")(princ)
(foreach i A
(foreach j B
(entmakex
(list '(0 . "LINE")
(cons 10 i)
(cons 11 j)
))
)
)
)

Chào truongthanh
Bạn nên upload file .dwg thay vì upload file .jpg nhé
Vì có thể người giúp bạn không hiểu hết ý của bạn. Với file .dwg thì trực quan và dễ hiểu nhất
Code này đã sửa lại. Hy vọng bạn hài lòng

Phạm vi áp dụng : đường vạt góc toàn là Line
hoặc đường vạt góc với các đường 1, đường 2 là Pline nối liền với nhau nhé.
Chú ý điều phạm...

Chào truongthanh
Bạn nên upload file .dwg thay vì upload file .jpg nhé
Vì có thể người giúp bạn không hiểu hết ý của bạn. Với file .dwg thì trực quan và dễ hiểu nhất
Code này đã sửa lại. Hy vọng bạn hài lòng

Phạm vi áp dụng : đường vạt góc toàn là Line
hoặc đường vạt góc với các đường 1, đường 2 là Pline nối liền với nhau nhé.
Chú ý điều phạm vi áp dụng của nó mà thực hiện cho đúng bạn nhé.

1 cách test Code là bạn vẽ hình chữ nhật bằng lệnh Rec -> chamfer -> sử dụng Lisp xem sao
Bạn cho ý kiến nhé


@conghoan : Tue_NV đang gặp rắc rối với Lisp VB này. Nhưng mình sẽ cố gắng để hoàn thành nó. Conghoan chờ tin

Em chưa hiều lắm về lisp nên chủ yếu copy code của các bác về sửa (em cũng sửa theo cảm tính chứ cũng chưa hiểu bản chất gì mấy) theo mục đích dùng của mình là chính. về đoạn lisp trên em mới chỉnh sửa được một đoạn code như thế này, nhưng có điều là sau khi Lock toàn bộ layer, em muốn unlock một (hoặc một vài) layer khác thì đoạn lisp này bị lỗi chỗ nào đó nên nó cứ hỏi tùy chọn...

Em chưa hiều lắm về lisp nên chủ yếu copy code của các bác về sửa (em cũng sửa theo cảm tính chứ cũng chưa hiểu bản chất gì mấy) theo mục đích dùng của mình là chính. về đoạn lisp trên em mới chỉnh sửa được một đoạn code như thế này, nhưng có điều là sau khi Lock toàn bộ layer, em muốn unlock một (hoặc một vài) layer khác thì đoạn lisp này bị lỗi chỗ nào đó nên nó cứ hỏi tùy chọn thêm mấy thứ nữa (cũng hơi lằng nhằng). Nhờ các bác xem và sửa hộ cho em thành sau khi gõ lệnh LKK rồi thì lisp sẽ cho mình tùy chọn layer(s) để unlock luôn ạ