Chào bạn Truongthanh,
Có phải bạn cần như thế này không????


Bạn lưu ý như sau:
1/- Lisp này viết dựa trên cái file bạn gửi. Do vậy nếu bạn dùng các định dạng khác của text thì nó sẽ không chịu trách nhiệm đâu nhé. (ví dụ bạn sử dụng mtext thì nó sẽ không lọc được đối tượng, bạn sử dụng cách nhập ký tự "phi" khác nó cũng sẽ không biết để nhận...

Chào bạn Truongthanh,
Có phải bạn cần như thế này không????


Bạn lưu ý như sau:
1/- Lisp này viết dựa trên cái file bạn gửi. Do vậy nếu bạn dùng các định dạng khác của text thì nó sẽ không chịu trách nhiệm đâu nhé. (ví dụ bạn sử dụng mtext thì nó sẽ không lọc được đối tượng, bạn sử dụng cách nhập ký tự "phi" khác nó cũng sẽ không biết để nhận dạng, bạn sử dụng số ký tự trong chuỗi text của bạn không đúng như bạn đã post thì nó sẽ cắt chuỗi sai và chạy sai .....)
2/- Do bạn chỉ yêu cầu thông báo kết quả nên mình chỉ trả kết quả bằng các thông báo alert, nếu bạn muốn tạo thành text trên bản vẽ thì cần cải tạo thêm một chút. Nếu bạn muốn lập bảng trên bản vẽ thì lại phải bổ xung thêm kha khá, và nếu bạn muốn xuất thành file text hay file xls sẽ lại phải phức tạp thêm bạn ạ.

Chúc bạn vui.

Chào bạn Truongthanh,
Lisp này mình bổ sung phần tạo bảng thống kê theo mẫu bạn đã gửi. Tuy nhiên phần bổ sung cho các kích thước có tới 4 chữ số thì mình chưa nghĩ ra giải pháp hữu hiệu vì muốn nó tổng quát hơn. Định mót của bác Tue_NV nhưng bác ấy xài file .fas nên mình bó tay luôn. Bạn chờ thêm chút để mình ngâm cứu thêm nha.


Trong lúc chờ đợi, bạn dùng thử...

Chào bạn Truongthanh,
Lisp này mình bổ sung phần tạo bảng thống kê theo mẫu bạn đã gửi. Tuy nhiên phần bổ sung cho các kích thước có tới 4 chữ số thì mình chưa nghĩ ra giải pháp hữu hiệu vì muốn nó tổng quát hơn. Định mót của bác Tue_NV nhưng bác ấy xài file .fas nên mình bó tay luôn. Bạn chờ thêm chút để mình ngâm cứu thêm nha.


Trong lúc chờ đợi, bạn dùng thử cái của bác Tue_NV xem sao, mình xài không nổi vì CAD 2004 của mình nó chả có cái hàm vla-addtable của bác Tue-NV, khổ thế....

Thật sự không biết các đối tượng Bạn cần dim là pline hở, đa giác lồi lỏm , ... nên xác định hướng đặt dim theo point rất khó. Do đó hướng giải quyết đơn giản và dễ làm là đặt dim bên trái hay phải của đối tượng (theo thứ tự point tạo nên line pline), nếu bên trái chưa đúng thì có thể chọn bên phải :-)
Và đây là code của TUE mình sửa lại . Bạn dùng tạm vậy

>>

Thật sự không biết các đối tượng Bạn cần dim là pline hở, đa giác lồi lỏm , ... nên xác định hướng đặt dim theo point rất khó. Do đó hướng giải quyết đơn giản và dễ làm là đặt dim bên trái hay phải của đối tượng (theo thứ tự point tạo nên line pline), nếu bên trái chưa đúng thì có thể chọn bên phải :-)
Và đây là code của TUE mình sửa lại . Bạn dùng tạm vậy



(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc vec)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)
) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE")) ))
(Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
;(setq d4 (getpoint "\nhuong dat dim :"))
(initget "T P")
(setq vec (getkword"\nDim dat ben trai hay phai <T>: "))

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq i 0)
(setq Lpoints (Tue-ent-Lpoint ent))
;(setq gocss (angle (car Lpoints) d4))
; (while (> gocss pi)
; (setq gocss (- gocss pi))
; )
; (if (> (angle (car Lpoints) (cadr Lpoints)) gocss) (setq goc (/ pi -2.0)) (setq goc (/ pi 2.0)))
(Repeat (1- (length Lpoints))
(setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints))
(setq goc (angle d1 d2))
(setq d3 (polar d1 (if (= vec "T")(+ goc (* pi 0.5))(- goc (* pi 0.5))) (* kc 500.0)))
;(setq d3 (polar d1 (+ goc (angle '(0 0 0) (vlax-curve-getFirstDeriv ent i))) (* kc 500.0)))
(command "dimaligned" d1 d2 d3)
(setq i (1+ i))
)
)
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)

Không biết bạn có câu trả lời chưa, theo mình biết khoảng cách này được tính từ điểm chèn của Text(mỗi text luôn có một điểm chèn +0 hoặc 1, 2 ,3 điểm căn chỉnh (Fit text) nữa) muốn biết tọa độ điểm này bạn dùng cú pháp lệnh list sau copy dán trực tiếp vào dòng lệnh(command)
(cdr(assoc 10 (entget(car(entsel"Chon Text muon tim diem chen")))))
với...

Không biết bạn có câu trả lời chưa, theo mình biết khoảng cách này được tính từ điểm chèn của Text(mỗi text luôn có một điểm chèn +0 hoặc 1, 2 ,3 điểm căn chỉnh (Fit text) nữa) muốn biết tọa độ điểm này bạn dùng cú pháp lệnh list sau copy dán trực tiếp vào dòng lệnh(command)
(cdr(assoc 10 (entget(car(entsel"Chon Text muon tim diem chen")))))
với mỗi lần copy và enter lệnh bạn chọn một text nào đó và enter kết quả là tọa độ (x y z) của điểm chèn text đó Thực hiện lệnh trừ hai tọa độ y cho nhau của hai Text bạn có khoảng cách bạn cần. Chẳng hạn:


(- (nth 1 (cdr(assoc 10 (entget(car(entsel"Chon Text 1"))))))
(nth 1 (cdr(assoc 10 (entget(car(entsel"Chon Text 2"))))))
)

Mình dùng các lệnh này trong list tự thêm một dòng Text vào hai dòng viết bằng DT, enter như bạn làm chi tiết list như sau

(defun themtext ( / b1 b2 delta point)
(setq b1 (cdr(assoc 10 (entget(car(entsel"Chon Text 1")))))
b2 (cdr(assoc 10 (entget(car(entsel"Chon Text 2"))))))
(setq delta (- (nth 1 b1) (nth 1 b2)))
(setq point (list (nth 0 b1) (- (nth 1 b2) delta) 0))
(command ".text" point pause)
)
(defun c:adtext()(themtext))

Tên lệnh là ADTEXT hoặc bạn có thể sửa tùy ý lại

Đã bổ sung hướng đặt DIM vào code của Tue_NV


(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch...

Đã bổ sung hướng đặt DIM vào code của Tue_NV


(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)
) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE")) ))
(Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(setq d4 (getpoint "\nHuong dat kich thuoc ? ") )
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(command "_.offset" (* kc 500.0) ent d4 "")
(setq d5 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(entdel (entlast))
(setq i 0)
(Repeat (1- (length (setq Lpoints (Tue-ent-Lpoint ent))))
(setq d1 (nth i Lpoints)
d2 (nth (1+ i) Lpoints)
)
(command "dimaligned" d1 d2 (nth i d5))
(setq i (1+ i))
)
)
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)


Muốn đặt DIM cách đối tượng 1 k/cách cố định thì Bạn xóa bỏ 3 dòng màu đỏ :
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
Rồi thêm dòng lệnh (setq kc a) tại vị trí vừa xóa, lúc này k/c từ DIM đến đối tượng là a*500 (a là 1 số thực)

edit: trong thẻ code không cho format color

Đây code của Bạn theo như yêu cầu:
Bạn chỉ cần 2 bước thực hiện: chọn đối tượng và pick điểm bên trong hay ngoài (trái, phải)
Lưu ý: vị trí đặt text của dim cách đối tượng 1 khoảng bằng chiều cao text của dim mặc định. Muốn thay đổi k/c này thì Bạn thay giá trị màu xanh là được
(setq kc (* 1 (cdr (assoc 140 (tblsearch "DIMSTYLE" (getvar...

Đây code của Bạn theo như yêu cầu:
Bạn chỉ cần 2 bước thực hiện: chọn đối tượng và pick điểm bên trong hay ngoài (trái, phải)
Lưu ý: vị trí đặt text của dim cách đối tượng 1 khoảng bằng chiều cao text của dim mặc định. Muốn thay đổi k/c này thì Bạn thay giá trị màu xanh là được
(setq kc (* 1 (cdr (assoc 140 (tblsearch "DIMSTYLE" (getvar "dimstyle"))))))

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)
) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE")) ))
(Progn

(setq kc (* 1 (cdr (assoc 140 (tblsearch "DIMSTYLE" (getvar "dimstyle"))))));k/cach bang chieu cao text cua DIM mac dinh
(setq d4 (getpoint "\nHuong dat kich thuoc ? ") )
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(command "_.offset" kc ent d4 "")
(setq d5 (Tue-ent-Lpoint (entlast)))
(entdel (entlast))
(setq i 0)
(Repeat (1- (length (setq Lpoints (Tue-ent-Lpoint ent))))
(setq d1 (nth i Lpoints)
d2 (nth (1+ i) Lpoints)
)
(command "dimaligned" d1 d2 d2)
(setq dl (entget(entlast)))
(setq d11 (cdr(assoc 11 dl))
d11n (inters d11 (polar d11 (+ (angle d1 d2) (/ pi 2.0)) kc) (nth i d5) (nth (1+ i) d5) nil)
)
(command "dimtedit" (entlast) d11n )
(setq i (1+ i))
)
)
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)

-Có 1 chút phát sinh bạn chỉnh dùm, la khi nhập khoảng cách nhỏ hơn 1 thì đường thẳng không vuông góc và khi chạy lisp truy bắt điểm bị tắt hết. Bạn chỉnh sửa dùm.Mình có đính kèm file cad và code

(defun c:dpl ()
(command "undo" "begin")
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(setq P1 (getpoint "\ncho diem dau: "))
(setq L (getreal...

-Có 1 chút phát sinh bạn chỉnh dùm, la khi nhập khoảng cách nhỏ hơn 1 thì đường thẳng không vuông góc và khi chạy lisp truy bắt điểm bị tắt hết. Bạn chỉnh sửa dùm.Mình có đính kèm file cad và code

(defun c:dpl ()
(command "undo" "begin")
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(setq P1 (getpoint "\ncho diem dau: "))
(setq L (getreal "\nnhap chieu dai: "))
(setq D 80.000)
(setq D1 (* (- L D) 1000))
(setq P2 (polar P1 (/ Pi 2) D1))
(command "line" P1 P2 "")
(while (setq kc (* (getreal "\nNhap khoang cach: ") 100))
(setq L (getreal "\nnhap chieu dai: "))
(setq D 80.000)
(setq D1 (* (- L D) 1000))
(setq P1 (polar P1 0 kc))
(setq P2 (polar P1 (/ Pi 2) D1))
(command "line" P1 P2 ""))
(acet-sysvar-restore)
(command "undo" "end")
(princ)
)

http://www.cadviet.c...974_banve_1.dwg

Chắc bac ketxu lại quên cái vụ này rồi, list của bác ấy thiếu phần bổ trợ các bác ạh. Theo em các bác dùng tạm hai list CD, BD đi khi nào rảnh bác ketxu up phần còn thiếu của list nên(hình như là hàm con DTR thì phải). Em up lại cho các bác ở đây vậy, cũng hông rõ là trước kia lấy từ nguồn nào nữa, trong máy có thì up thôi, xin phép trước ạ
;;;------------------------CAT CHAN...

Chắc bac ketxu lại quên cái vụ này rồi, list của bác ấy thiếu phần bổ trợ các bác ạh. Theo em các bác dùng tạm hai list CD, BD đi khi nào rảnh bác ketxu up phần còn thiếu của list nên(hình như là hàm con DTR thì phải). Em up lại cho các bác ở đây vậy, cũng hông rõ là trước kia lấy từ nguồn nào nữa, trong máy có thì up thôi, xin phép trước ạ
;;;------------------------CAT CHAN DIM---------------
(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
*error* myerror)
(PRINC "Hay chon duong kich thuoc can thay doi!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
(PROGN
(SETQ PT10 (CDR (ASSOC 10 DS)))
(SETQ PT11 (CDR (ASSOC 11 DS)))
(SETQ PT13 (CDR (ASSOC 13 DS)))
(SETQ PT14 (CDR (ASSOC 14 DS)))
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(PROGN
(SETQ GOCY (ANGLE PT10 PT14))
(SETQ GOCX (+ GOCY (/ PI 2)))
)
)
(SETVAR "OSMODE" 0)
(SETQ PTI (POLAR PT GOCX 2))
(SETQ PT13I (POLAR PT13 GOCY 2))
(SETQ PT14I (POLAR PT14 GOCY 2))
(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
(SETQ O13 (ASSOC 13 DS))
(SETQ O14 (ASSOC 14 DS))
(SETQ N13 (CONS 13 PT13N))
(SETQ N14 (CONS 14 PT14N))
(SETQ DS (SUBST N13 O13 DS))
(SETQ DS (SUBST N14 O14 DS))
(ENTMOD DS)
)
)
(SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(PRINC)
)
;;;------------------------CHUYEN DUONG DIM VE VI TRI MOI---------------
(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
*error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
(PROGN
(SETQ PT13 (CDR (ASSOC 13 DS)))
(SETQ PT14 (CDR (ASSOC 14 DS)))
(SETQ PT10 (CDR (ASSOC 10 DS)))
(SETQ PT11 (CDR (ASSOC 11 DS)))
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(PROGN
(SETQ GOCY (ANGLE PT10 PT14))
(SETQ GOCX (+ GOCY (/ PI 2)))
)
)
(SETVAR "OSMODE" 0)
(SETQ PTI (POLAR PT GOCX 2))
(SETQ PT10I (POLAR PT10 GOCY 2))
(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
(SETQ KC (DISTANCE PT10 PT10N))
(SETQ O10 (ASSOC 10 DS))
(SETQ N10 (CONS 10 PT10N))
(SETQ DS (SUBST N10 O10 DS))
(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
(SETQ O11 (ASSOC 11 DS))
(SETQ N11 (CONS 11 PT11N))
(SETQ DS (SUBST N11 O11 DS))
(ENTMOD DS)
)
)
(SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)
;-----------------------------------------------------------------------------------------------------------

Đã chỉnh sửa lại theo yêu cầu của bạn. Tuy nhiên file bạn gửi thì nội dung text với elevation của text là khác nhau.

(defun c:chm()
(setq i 1)
(command "osnap" "node,center,ins,end,mid")
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal (strcat "\n Chi\U+1EC1u cao text <"
(rtos *chieucao* 2 2)
"> :"
)
...

Đã chỉnh sửa lại theo yêu cầu của bạn. Tuy nhiên file bạn gửi thì nội dung text với elevation của text là khác nhau.

(defun c:chm()
(setq i 1)
(command "osnap" "node,center,ins,end,mid")
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal (strcat "\n Chi\U+1EC1u cao text <"
(rtos *chieucao* 2 2)
"> :"
)
)
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
(or *xoay* (setq *xoay* 0))
(setq xoay (getreal (strcat "\n G\U+00F3c xoay text <"
(rtos *xoay* 2 2)
"> :"
)
)
)

(if (not xoay) (setq xoay *xoay*) (setq *xoay* xoay))
(command "undo" "be")
(setq pt1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t : "))
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq z1 (caddr pt1))
(setq pt2 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai : "))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq z2 (caddr pt2))
(setq Diem1 (list x1 y1))
(setq Diem2 (list x2 y2))
(setq d (distance diem1 diem2))
(setq n (getint "\nNh\U+1EADp s\U+1ED1 \U+0111i\U+1EC3m c\U+1EA7n ch\U+00E8n: "))
(setq kcl (/ d n))
(setq gocdt (angle diem1 diem2))
(while (< i n)
(command "osnap" "Off")
(setq pt_i (polar diem1 gocdt (* i kcl)))
(setq x3 (car pt_i))
(setq y3 (cadr pt_i))
(setq d1 (distance diem1 pt_i))
(setq d2 (distance diem2 pt_i))
(setq kcdai (+ d1 d2))
(setq dz12 (- z2 z1))
(setq dhz (* dz12 (/ d1 kcdai)))
(setq z3 (+ z1 dhz))
(setq Caodo (rtos z3 2 2))
(setq pt_i (list x3 y3 (atof Caodo)))
(entmake (list (cons 0 "TEXT")(cons 1 caodo) (cons 10 pt_i) (cons 40 chieucao)(cons 50 (DTR xoay))))
(entmake (list (cons 0 "POINT") (cons 10 pt_i)))
(setq i (1+ i))
)
(command "undo" "end")
(princ)
)
(defun c:chd()
(setq i 1)
(command "osnap" "node,center,ins,end,mid")
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal (strcat "\n Chi\U+1EC1u cao text <"
(rtos *chieucao* 2 2)
"> :"
)
)
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
(or *xoay* (setq *xoay* 0))
(setq xoay (getreal (strcat "\n G\U+00F3c xoay text <"
(rtos *xoay* 2 2)
"> :"
)
)
)
(if (not xoay) (setq xoay *xoay*) (setq *xoay* xoay))
(command "undo" "be")
(setq pt1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t : "))
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq z1 (caddr pt1))
(setq pt2 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai : "))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq z2 (caddr pt2))
(setq Diem1 (list x1 y1))
(setq Diem2 (list x2 y2))
(setq d (distance diem1 diem2))
(setq kcl (getint "\nNh\U+1EADp kho\U+1EA3ng c\U+00E1ch gi\U+1EEFa 2 \U+0111i\U+1EC3m: "))
(setq n (/ d kcl))
(setq gocdt (angle diem1 diem2))
(while (< i n)
(command "osnap" "Off")
(setq pt_i (polar diem1 gocdt (* i kcl)))
(setq x3 (car pt_i))
(setq y3 (cadr pt_i))
(setq d1 (distance diem1 pt_i))
(setq d2 (distance diem2 pt_i))
(setq kcdai (+ d1 d2))
(setq dz12 (- z2 z1))
(setq dhz (* dz12 (/ d1 kcdai)))
(setq z3 (+ z1 dhz))
(setq Caodo (rtos z3 2 2))
(setq pt_i (list x3 y3 (atof Caodo)))
(entmake (list (cons 0 "TEXT")(cons 1 caodo) (cons 10 pt_i) (cons 40 chieucao)(cons 50 (DTR xoay))))
(entmake (list (cons 0 "POINT") (cons 10 pt_i)))
(setq i (1+ i))
)
(command "undo" "end")
(princ)
)
(defun c:cdlt() ;chen diem lien tiep
(setq i 1)
(command "osnap" "node,center,ins,end,mid")
(or *chieucao* (setq *chieucao* 2))
(setq chieucao (getreal (strcat "\n Chi\U+1EC1u cao text <"
(rtos *chieucao* 2 2)
"> :"
)
)
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
(or *xoay* (setq *xoay* 5))
(setq xoay (getreal (strcat "\n G\U+00F3c xoay text <"
(rtos *xoay* 2 2)
"> :"
)
)
)
(if (not xoay) (setq xoay *xoay*) (setq *xoay* xoay))
(command "undo" "be")
(setq pt1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t : "))
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq z1 (caddr pt1))
(setq pt2 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai : "))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq z2 (caddr pt2))
(setq Diem1 (list x1 y1))
(setq Diem2 (list x2 y2))
(setq d (distance diem1 diem2))
(while
(progn
(command "osnap" "Off")
(setq pt_i (getpoint "\n Ch\U+1ECDn \U+0111i\U+1EC3m c\U+1EA7n ch\U+00E8n: "))
(setq x3 (car pt_i))
(setq y3 (cadr pt_i))
(setq d1 (distance diem1 pt_i))
(setq d2 (distance diem2 pt_i))
(setq kcdai (+ d1 d2))
(setq dz12 (- z2 z1))
(setq dhz (* dz12 (/ d1 kcdai)))
(setq z3 (+ z1 dhz))
(setq Caodo (rtos z3 2 2))
(setq pt_i (list x3 y3 (atof Caodo)))
(entmake (list (cons 0 "TEXT")(cons 1 Caodo) (cons 10 pt_i) (cons 40 chieucao)(cons 50 (DTR xoay))))
(entmake (list (cons 0 "POINT") (cons 10 pt_i)))
(setq i (1+ i))
)
)
(command "undo" "end")
(princ)
)
(defun DTR (A) (/ (* A pi) 180.0))

(defun ST:Text-Base (ent)
(setq Ma10 (cdr (assoc 10 (entget ent))))
(setq Ma11 (cdr (assoc 11 (entget ent))))
(setq X11 (car Ma11))
(setq Ma71 (cdr (assoc 71 (entget ent))))
(setq Ma72 (cdr (assoc 72 (entget ent))))
(if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
(and (= Ma71 0) (= Ma72 3) )
(and (= Ma71 0) (= Ma72 5) )
)
Ma10
Ma11
)
)
(defun C:CVT3D (/ ss Tdo Caodo Pnt temp )
(command "undo" "be")
(command "osnap" "off")
(setq ss (ssget (list (cons 0 "TEXT"))))
(progn
(setq ss (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
(foreach item ss
(setq temp (entget item)
Tdo (ST:Text-Base item )
Caodo (cdr (assoc 1 temp))
Pnt (list (car Tdo)(cadr Tdo)(atof caodo))
)
(setq temp (subst (cons 10 Pnt)(assoc 10 temp) temp))
(entmod temp)
(entmake (list (cons 0 "POINT") (cons 10 Pnt) ))
)
)
(command "undo" "end")
(princ)
)

Em có tham khảo và sử dụng các "Lisp chỉnh style TEXT trong block thuộc tính" trên diễn đàn như: wo.lsp, rba_wo_ho.lsp, ho_Styb.lsp... tuy nhiên các Lisp trên chỉ thay đổi chiều rộng, chiều cao, Style của các Attribute
chứ không thay đổi được cho các "Text" của Block Attribute.
Em có nhiều Block Attribute ghi diện tích như trong hìnhhttp://www.cadviet.com/upfiles/3/88193_thay_doi_chieu_cao_text.png...

>>

Em có tham khảo và sử dụng các "Lisp chỉnh style TEXT trong block thuộc tính" trên diễn đàn như: wo.lsp, rba_wo_ho.lsp, ho_Styb.lsp... tuy nhiên các Lisp trên chỉ thay đổi chiều rộng, chiều cao, Style của các Attribute
chứ không thay đổi được cho các "Text" của Block Attribute.
Em có nhiều Block Attribute ghi diện tích như trong hìnhhttp://www.cadviet.com/upfiles/3/88193_thay_doi_chieu_cao_text.png...
Nhờ các Bác viết giúp em lisp chỉnh chiều cao cho cả Text và Attribute cho Block với.
Xin chân thành cảm ơn !

;; free lisp from cadviet.com-- Doi chieu cao, do rong, style cho Attribute cua Blocks
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=47445&st=0
(defun c:wo( / ssdt sodt index tt entdt w getsty h)
(setq ssdt (ssget '((0 . "INSERT") (66 . 1)))
sodt (sslength ssdt)
index 0
)
(setq w (getreal "\n Nhap be rong chu :"))
(setq h (getreal "\n Nhap chieu cao chu :"))
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
(progn
(or newsty (setq newsty (getvar "textstyle")))
(setq res "" resinit "" tbsty nil)
(while (setq tbsty (tblnext "style" (null tbsty)))
(setq sty (cdr (assoc 2 tbsty))
res (strcat res "/" sty )
resinit (strcat resinit " " sty )))
(setq res (substr res 2)
resinit (substr resinit 2))

(setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
(mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
(initget (strcat " " resinit))
(setq getsty (getkword (strcat "\nChon Style ") ))
(and getsty (setq newsty getsty))
(mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)

)
(setq getsty (getstring (strcat "\nChon Style ") ))
)
(repeat sodt
(setq entdt (ssname ssdt index)
index (1+ index))
(while (/= (cdr(assoc 0 (entget entdt))) "SEQEND")
(setq
entdt (entnext entdt)
tt (entget entdt)
)
(if getsty (if (tblsearch "style" getsty) (setq tt (subst (cons 7 getsty) (assoc 7 tt) tt))) )
(if w (setq tt (subst (cons 41 w) (assoc 41 tt) tt)))
(if h (setq tt (subst (cons 40 h) (assoc 40 tt) tt)))

(entmod tt)
(entupd entdt)
)
)
(princ)
)

Các Bạn thử lại lisp sau

(defun c:sd ( / lstd pt xpt ypt xp yp pt1 goc h_textdim
p10 p11 p13 p14 oldp10 oldp11 oldp13 oldp14)
(setq #OSMODE (getvar "OSMODE"))
(command "_.Undo" "be")
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(princ "\nChon cac DIM can sap xep")
(while (setq lstd (ssget (list(cons 0 "DIMENSION");"AcDbAlignedDimension"...

Các Bạn thử lại lisp sau

(defun c:sd ( / lstd pt xpt ypt xp yp pt1 goc h_textdim
p10 p11 p13 p14 oldp10 oldp11 oldp13 oldp14)
(setq #OSMODE (getvar "OSMODE"))
(command "_.Undo" "be")
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(princ "\nChon cac DIM can sap xep")
(while (setq lstd (ssget (list(cons 0 "DIMENSION");"AcDbAlignedDimension" "AcDbRotatedDimension"
(cons -4 "<OR")(cons 70 32)(cons 70 33)(cons 70 64)(cons 70 65)(cons 70 128)(cons 70 129)
(cons 70 96)(cons 70 97)(cons 70 160)(cons 70 161)(cons 70 196)(cons 70 197)(cons 70 224)(cons 70 225)(cons -4 "OR>")
;(cons -4 "<OR")(cons 50 0)(cons 50 pi)(cons 50 (/ pi 2))(cons 50 (* 1.5 pi))(cons -4 "OR>")
)
)
)
(setq lstd (vl-remove-if 'listp (mapcar 'cadr (ssnamex lstd))))
(or h_textdim (setq h_textdim (cdr (assoc 140 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget (car lstd)))))));chieu cao text dim
d1014 (* 3 h_textdim);k/c tu chan duong giong den duong ghi kich thuoc
d2d (* 4 h_textdim);k/c giua 2 duong kich thuoc
pt (getpoint "\nChon vi tri moi cua chan duong giong kich thuoc")
xpt (car pt)
ypt (cadr pt)
xp xpt
yp ypt
pt1 pt
)
)
(while lstd
(setq en (entget (car lstd))
oldp10 (cdr(assoc 10 en))
oldp11 (cdr(assoc 11 en))
oldp13 (cdr(assoc 13 en))
oldp14 (cdr(assoc 14 en))
goc (angle oldp14 oldp10)
delta_y (- (cadr oldp10)(cadr oldp11))
delta_x (- (car oldp10)(car oldp11))
)
(cond

((= (rem goc pi) 0.0)(setq p13 (list xpt(cadr oldp13) (caddr oldp13)); DIM dung
p14 (list xpt (cadr oldp14) (caddr oldp14))
p10 (polar p14 (angle p14 oldp10) d1014)
p11 (list (- (car p10) delta_x) (cadr oldp11) (caddr oldp11))
xp (car (polar p14 (angle p14 oldp10) d2d))
)
)
((= (rem goc (* pi 0.5)) 0.0)(setq p13 (list (car oldp13) ypt (caddr oldp13)); DIM ngang
p14 (list (car oldp14) ypt (caddr oldp14))
p10 (polar p14 (angle p14 oldp10) d1014)
p11 (list (car oldp11) (- (cadr p10) delta_y) (caddr oldp11))
yp (cadr (polar p14 (angle p14 oldp10) d2d))
)
)
(t(setq p13 (inters (polar oldp13 goc d1014) oldp13 pt (polar pt (+ goc (* pi 0.5)) d1014) nil)
p14 (inters oldp14 oldp10 pt (polar pt (+ goc (* pi 0.5)) d1014) nil); DIM ali
p10 (polar p14 (angle p14 oldp10) d1014)
p11 (polar oldp11 (angle oldp10 p14) (distance p10 oldp10))
pt1 (polar pt (angle p14 oldp10) d2d)
)
)
)
(setq en (subst (cons 13 p13)(assoc 13 en) en)
en (subst (cons 14 p14)(assoc 14 en) en)
en (subst (cons 10 p10)(assoc 10 en) en)
en (subst (cons 11 p11)(assoc 11 en) en)
lstd (cdr lstd)
)
(entmod en)
);for
(princ "\nChon cac DIM can sap xep")
(setq xpt xp ypt yp pt pt1)
);while
(setvar "OSMODE" #OSMODE)
(command "_.Undo" "en")
(princ)
)


Lưu ý: các đường DIM nghiêng có điểm dóng (dxf14) nằm trên đường ghi kích thước có nghĩ là không có đường dóng thì sẽ không đúng
lisp ở bài #1 để mình xem lại cách tính góc nghiêng cho chính xác hơn

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12103&st=0
(defun c:dcs(/ tlv blm blname dmo cdm cd dm cdmi dmoc)
(setvar "attreq" 1)
(setvar "cmdecho" 0)
(setq oldim (getvar "DimZin"))
(setvar "Dimzin" 0)
(setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/")))
(setq blm (entget(car(entsel "\n Pick chon Block mau...

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12103&st=0
(defun c:dcs(/ tlv blm blname dmo cdm cd dm cdmi dmoc)
(setvar "attreq" 1)
(setvar "cmdecho" 0)
(setq oldim (getvar "DimZin"))
(setvar "Dimzin" 0)
(setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/")))
(setq blm (entget(car(entsel "\n Pick chon Block mau :"))))
(setq blname (cdr(assoc 2 blm)))
(setq TLX (cdr(assoc 41 blm)))
(setq TLY (cdr(assoc 42 blm)))
(setq dmo (getpoint "\n Pick diem moc : "))
(setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : "))
(if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) )
(if cdm (progn))
(if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2))))
(if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2))))
(if (< cdm 0) (setq cd (rtos cdm 2 2)))
;(command "insert" blname dmo TLX TLY "0" cd)
(setq dmoc dmo)
(while (setq dm (getpoint dmoc "\n Pick diem tiep theo :"))
(if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) )
(if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) )
(if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2))))
(if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2))))
(if (< cdmi 0) (setq cdi (rtos cdmi 2 2)))
(command "insert" blname dm TLX TLY "0" cdi)
(setq dmoc dm)
)
(setvar "Dimzin" oldim)
(princ)
)


Đoạn lisp trên e kết hợp 2 lần chỉnh sửa của bác Tuenv và đã cho ra kết quả đúng của dạng blog.
Tuy nhiên khi blog insert ra thì lại bị scan nhỏ đi rất nhiều so với blog mẫu.
Các bác cho e hỏi nguyên nhân tại sao lại như vậy?

Nhờ các bác sửa giúp em code dưới đây, để khi gọi lệnh CG thì phần hiển thị nội dung ở dòng command dưới màn hình không hiển thị phần phần đánh dấu màu đỏ bên dưới đây:
Command: CG
CHON GOC TRAI-DUOI BAN VEUnknown command "CG". Press F1 for help. (chỗ này nó báo lỗi gì vậy nhỉ?)
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.

>>

Nhờ các bác sửa giúp em code dưới đây, để khi gọi lệnh CG thì phần hiển thị nội dung ở dòng command dưới màn hình không hiển thị phần phần đánh dấu màu đỏ bên dưới đây:
Command: CG
CHON GOC TRAI-DUOI BAN VEUnknown command "CG". Press F1 for help. (chỗ này nó báo lỗi gì vậy nhỉ?)
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "N". Press F1 for help.
Unknown command "CG". Press F1 for help.
Unknown command "CG". Press F1 for help.
CHON TY LE BAN VE (100 : 200 : 250 : 500 : 1000 : 2000) :200
nil


(defun C:CG (/ VERSION D V DIEMCHEN TENFILE DUONGDAN LOAIHS MSTL)
(command "cmdecho" 0)
(command "osnap" "none")
(setq DIEMCHEN (getpoint "CHON GOC TRAI-DUOI BAN VE"))
(chenkhung DIEMCHEN) ;VE CAC KHUNG TY LE CHUAN DE DINH HUONG
(setq MSTL
(getreal
"\n CHON TY LE BAN VE (100 : 200 : 250 : 500 : 1000 : 2000) :"
)
)
;XOA CAC KHUNG DINH HUONG
(repeat 12
(command "_erase" (ssget "L") "")
)
;CHEN MAU HO SO VAO
(setq VERSION (getvar "roamablerootprefix"))
(setq D (strlen VERSION))
(setq V (substr VERSION (- D 11) 1))
(setq DUONGDAN (strcat "c:\\program files\\AutoCAD 200"V"\\thu_vien\\"))
(setq LOAIHS "CapGiay")
(setq TENFILE (strcat LOAIHS (rtos MSTL 2 0) ".dwg"))
(ChenBlock DUONGDAN TENFILE DIEMCHEN (/ MSTL 1000))
) ;END DEFUN CG

(defun ChenBlock
(DUONGDAN TENFILE DIEMCHEN TYLE / TENCHEN)
(setq TENCHEN (strcat "*" DUONGDAN TENFILE))
(command "-insert" TENCHEN DIEMCHEN TYLE "0")
(Command "zoom" "e")
)
(defun TaoKhung (TEXT TYLE P1 P2 / TEXT TYLE P1 P2)
(command "-STYLE" "TEXTTRL" "VNI-AVO" TYLE "1" "0" "N" "N" "N")
(command "-text" "J" "BL" P2 "0" TEXT "")
(command "_rectang"
P1
P2
""
)
) ;END DEFUN
(defun ChenKhung (D / P1 P2)
(command "-layer" "s" "0" "" "")
(setq P1 (list (+ (car D) 17) (cadr D)))
(setq P2 (list (car D) (+ (cadr D) 25)))
(TaoKhung " Khung ty le 1/100" 1 P1 P2)
(setq P1 (list (+ (car D) 34) (cadr D)))
(setq P2 (list (car D) (+ (cadr D) 45)))
(TaoKhung " Khung ty le 1/200" 2 P1 P2)
(setq P1 (list (+ (car D) 42) (cadr D)))
(setq P2 (list (car D) (+ (cadr D) 57)))
(TaoKhung " Khung ty le 1/250" 2.5 P1 P2)
(setq P1 (list (+ (car D) 84) (cadr D)))
(setq P2 (list (car D) (+ (cadr D) 112)))
(TaoKhung " Khung ty le 1/500" 5 P1 P2)
(setq P1 (list (+ (car D) 168) (cadr D)))
(setq P2 (list (car D) (+ (cadr D) 225)))
(TaoKhung " Khung ty le 1/1000" 10 P1 P2)
(setq P1 (list (+ (car D) 337) (cadr D)))
(setq P2 (list (car D) (+ (cadr D) 450)))
(TaoKhung " Khung ty le 1/2000" 20 P1 P2)
(Command "zoom" "e")
) ; end defun