Nếu có lỗi thì bạn thông báo cho mọi người để cả nhà cùng chữa hỏa. để nhà nước khỏi mất tiền để xây cho anh em ta căn biệt thự bằng đá phiến.
Nhân tiện cho mình hỏi luôn. Lisp đang chỉ thực hiện khi là LWPOLYLINE giờ muốn nó thực hiện luôn với POLYLINE thì làm thế nào.
VD lisp này của Mr. PhamThanhBinh. với POLYLINE thì ko thực hiện được

;; free lisp from...

Nếu có lỗi thì bạn thông báo cho mọi người để cả nhà cùng chữa hỏa. để nhà nước khỏi mất tiền để xây cho anh em ta căn biệt thự bằng đá phiến.
Nhân tiện cho mình hỏi luôn. Lisp đang chỉ thực hiện khi là LWPOLYLINE giờ muốn nó thực hiện luôn với POLYLINE thì làm thế nào.
VD lisp này của Mr. PhamThanhBinh. với POLYLINE thì ko thực hiện được

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63126&pid=195881&st=0&#entry195881

(defun c:gcoor (/ oldos k k1 p pl pls1 pmin pmax plst sc sh p1el ss1 ssl1 ssl2)
(Init)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
;;; Ve duong bao
;;;(command "pline")
;;;(While (setq p (getpoint "\n chon lan luot cac dinh cua duong bao"))
;;; (command p)
;;
;;;(command "c")
(setq pl (car (entsel "\n Pick chon duong bao " ))
pls1 (acet-ent-geomextents pl)
pmin (list (* (1- (fix (/ (caar pls1) k1))) k1) (* (1- (fix (/ (cadar pls1) k1))) k1))
pmax (list (* (1+ (fix (/ (caadr pls1) k1))) k1) (* (1+ (fix (/ (cadadr pls1) k1))) k1))
)
;;;;;;Tao danh sach diem grid
(setq plst (list pmin)
sc 1)
(while (<= (+ (car pmin) (* sc k1)) (car pmax))
(setq p (list (+ (car pmin) (* sc k1)) (cadr pmin))
plst (append plst (list p))
sc (1+ sc)
)
)
(foreach p plst
(setq sh 1)
(while (<= (+ (cadr p) (* sh k1)) (cadr pmax))
(setq p1 (list (car p) (+ (cadr p) (* sh k1)))
plst (append plst (list p1))
sh (1+ sh)
)
)
)
plst
;;;;;;;;;;; Tao grid
(setq el (entlast)
ss1 (ssadd))
(foreach p plst
(xy p)
)
;;;; Loc grid
(while (setq el (entnext el))
(setq ss1 (ssadd el ss1))
)
(setq ssl1 (acet-ss-to-list ss1))
(setq ppl (list)
par 0
pob (vlax-ename->vla-object pl) )
(while (<= par (vlax-curve-getendparam pob))
(setq pa (vlax-curve-getpointatparam pob par)
ppl (append ppl (list pa))
par (+ par 0.1)
)
)
(setq ssl2 (acet-ss-to-list (ssget "cp" ppl )))
(foreach x ssl1
(if (not (member x ssl2))
(entdel x)
)
)


(setvar "osmode" oldos)
(command "undo" "e")
(Reinit)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;CT chich toa do tren ban do
;;;
(Defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
(setvar "LUPREC" 0)
(setq stl "standard")
(setq k (getint "\n nhap ty le ban do: ") k1 (/ k 10) ) (setq scale k)
(setq hi (* 0.002 scale))
(setq wi 0.9)
)
(Defun Reinit()
(setvar "BLIPMODE" 1)
(setvar "CMDECHO" 1)
(setvar "LUPREC" 4)
(princ)
)
(Defun XY( pt / x y xx yy ptx pty)


(setq y (car pt))
(setq x (cadr pt))
(command "_Line"
(list (- y (* 0.0025 scale)) x 0.0)
(list (+ y (* 0.012 scale)) x 0.0) ""
)
(command "_Line"
(list y (- x (* 0.0025 scale)) 0.0)
(list y (+ x (* 0.0025 scale)) 0.0) ""
)
(setq xx (rtos x 2))
(setq yy (rtos y 2))
(setq pt y)
(setq y x)
(setq x pt)
(setq ptx (list (+ x (* 0.001 scale)) (- y (* 0.0025 scale)) 0.0))
(setq pty (list (+ x (* 0.0025 scale)) (+ y (* 0.001 scale)) 0.0))
(Maketext ptx 0 xx)
(Maketext pty 90 yy)

)
(Defun Maketext( diem ang string / etd)
(setq edt (list (cons 0 "text")
(cons 8 "GhichuTD")
(cons 62 5)
(cons 10 diem)
(cons 1 string)
(cons 7 stl)
(cons 40 hi)
(cons 41 wi)
(cons 50 (/ (* ang PI) 180.0))
)
)
(entmake edt)
)

Vinh dự nhá ^^
http://www.cadviet.com/forum/index.php?showtopic=15687&view=findpost&p=197113

Về yêu cầu của bạn thì đây :

(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), 1 ,$(-, $(strlen,...

Vinh dự nhá ^^
http://www.cadviet.com/forum/index.php?showtopic=15687&view=findpost&p=197113

Về yêu cầu của bạn thì đây :

(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), 1 ,$(-, $(strlen, $(getvar, dwgname))," (itoa (getint "\nSo ky tu muon cat bot:")) ")) >%")
))

Hề hề hề,
Đây là lisp dùng để lấy danh sách tọa độ các điểm cùng với mã tên điểm như bạn yêu cầu, Tuy nhiên có vẻ như bạn không cần nữa. Dù sao thì cũng đã lỡ mần nên cứ gửi lên đây. Hy vọng sẽ có ích cho ai đó cần quan tâm tới nó.
Mình chả hiểu TOPO nó là cái giống oẳn tà roằn nào nên chả biết lisp này có xài được trên đó hay không.
Còn trên bản vẽ...

Hề hề hề,
Đây là lisp dùng để lấy danh sách tọa độ các điểm cùng với mã tên điểm như bạn yêu cầu, Tuy nhiên có vẻ như bạn không cần nữa. Dù sao thì cũng đã lỡ mần nên cứ gửi lên đây. Hy vọng sẽ có ích cho ai đó cần quan tâm tới nó.
Mình chả hiểu TOPO nó là cái giống oẳn tà roằn nào nên chả biết lisp này có xài được trên đó hay không.
Còn trên bản vẽ CAD như chủ thớt đã gửi thì nó chạy cũng coi được. Sau khi đã có cái danh sách này thì tùy theo yêu cầu mà các bác có thể xử lý thêm giấm thêm ớt cho nó vừa với cái khẩu vị của các bác vậy.
Hề hề hề,...


Vì là chả biết có ai còn quan tâm nữa nên mình cũng chả thèm khử biến nữa. Điều này nếu ai cần có thể tự xử lý được mà, Chỉ nhắc vậy để mọi người lưu ý.
Hề hề hề,..

Hề hề hề,
Chuyện đưa nó ra file csv chả khó khăn gì. Trên diễn đàn đã có rất nhiều file để chguye63n số liệu từ một list (danh sách) sang file csv, txt, xls rồi mà. Chỉ thêm vài dòng code nữa là Ok.
Bạn đã nói vậy thì chờ chút, giờ hết giờ rùi, mình phải chuồn, tối về sẽ post cho bạn.
Chúc bạn vui...

Hề hề hề,
Nó đây bạn ạ:


Bạn...

Hề hề hề,
Chuyện đưa nó ra file csv chả khó khăn gì. Trên diễn đàn đã có rất nhiều file để chguye63n số liệu từ một list (danh sách) sang file csv, txt, xls rồi mà. Chỉ thêm vài dòng code nữa là Ok.
Bạn đã nói vậy thì chờ chút, giờ hết giờ rùi, mình phải chuồn, tối về sẽ post cho bạn.
Chúc bạn vui...

Hề hề hề,
Nó đây bạn ạ:


Bạn hãy thử và nếu cần bổ sung gì thì post lên nhé.

Giảm thao tác Undo và cmdecho thì sẽ giảm được 1 nửa time

(defun c:gifpr (/ ss n plst i en el p ma k tmp fw val)
(defun val (a e)(cdr (assoc a (entget e))))
(defun cont(e / tmp)(substr (setq tmp (val 1 e)) (+ 4 (vl-string-search "\\l" tmp))))
(vl-load-com)
(setq Start (getvar "Millisecs"))
(setvar...

Giảm thao tác Undo và cmdecho thì sẽ giảm được 1 nửa time

(defun c:gifpr (/ ss n plst i en el p ma k tmp fw val)
(defun val (a e)(cdr (assoc a (entget e))))
(defun cont(e / tmp)(substr (setq tmp (val 1 e)) (+ 4 (vl-string-search "\\l" tmp))))
(vl-load-com)
(setq Start (getvar "Millisecs"))
(setvar 'cmdecho 0)
(command "undo" "Mark")
(setq ss (ssget (list (cons 0 "acad_proxy_entity")))
n (sslength ss)
plst (list)
i -1
tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv" 1)
fw (open tmp "w")
)
(while (< i n)
(setq en (entlast))
(command "explode" (ssname ss (setq i (1+ i))))
(while (setq en (entnext en))
(cond ((= (val 0 en) "CIRCLE") (setq p (val 10 en)))
(T (if (= (val 62 en) 2)(setq num (cont en))(setq nm (cont en))))
)
)
(write-line (strcat num (chr 44) nm (chr 44) (apply 'strcat (mapcar '(lambda(x)(strcat (rtos x 2 2) (chr 44))) p))) fw)

)
(close fw)
(command "undo" "back")
(setq End (getvar "Millisecs"))
(alert (vl-princ-to-string (* (- end start) 0.001)))
(princ)
)

Tặng mọi người Lisp giải bài toán này.
Lệnh: Csum
- Xuất thống kê (txt hoặc excel).
- Có 2 tùy chọn để nhặt đối tượng (TEXT và MTEXT)
M: chọn 1 text mẫu -> trình tự động nhặt tất cả
C: Chọn trên màn hình
- Xuất txt chọn: T
Xuất Excel chọn: E

Good Luck

Tặng mọi người Lisp giải bài toán này.
Lệnh: Csum
- Xuất thống kê (txt hoặc excel).
- Có 2 tùy chọn để nhặt đối tượng (TEXT và MTEXT)
M: chọn 1 text mẫu -> trình tự động nhặt tất cả
C: Chọn trên màn hình
- Xuất txt chọn: T
Xuất Excel chọn: E

Good Luck .


(defun CreateDataList(text / i truoc sau)
(vl-load-com)
(setq i (1+ (vl-string-search "," text))
truoc (substr text 1 (1- i))
sau (substr text (1+ i) (- (strlen text) i))
sau (vl-string-subst "" " " sau)
sau (vl-string-subst "" "l" sau)
sau (vl-string-subst "" "L" sau)
)
(list truoc sau)
)
;======================================================================================================
(defun GetObject(/ kw)
(initget "M C")
(if (= key nil)
(progn
(setq kw (getkword (strcat "\nKi\U+1EC3u ch\U+1ECDn <C>: ")))
(if (= kw nil) (setq kw "C"))
)
(progn
(setq kw (getkword (strcat "\nKi\U+1EC3u ch\U+1ECDn <" key ">: ")))
(if (= kw nil) (setq kw key))
)
)
(setq key kw)
(defun Mselect(/ chk mau ssx)
(setq chk T)
(while chk
(setq mau (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+1EABu: ")))
(if mau (setq chk nil))
)
(setq ssx (ssget "_X" (list
(cons -4 "<OR")
(cons 0 "TEXT")
(cons 0 "MTEXT")
(cons -4 "OR>")
(cons 8 (cdr (assoc 8 (entget mau))))
(cons -4 "<OR")
(cons 1 "*#*`,L#*")
(cons 1 "*#*`, L#*")
(cons -4 "OR>")
)
)
)
)
(defun Cselect(/ ssx)
(setq ssx (ssget (list
(cons -4 "<OR")
(cons 0 "TEXT")
(cons 0 "MTEXT")
(cons -4 "OR>")
(cons -4 "<OR")
(cons 1 "*#*`,L#*")
(cons 1 "*#*`, L#*")
(cons -4 "OR>")
)
)
)
)
(cond
((= kw "C") (setq ssx (Cselect)))
((= kw "M") (setq ssx (Mselect)))
)
ssx
)
;======================================================================================================
(defun Summary(/ ssx DataList di AllType Dtype TypeI xi Tsum ExportData)
(setq ssx (GetObject)
DataList '()
di 0
)
(while (< di (sslength ssx))
(setq DataList (append DataList (list (CreateDataList (cdr (assoc 1 (entget (ssname ssx di))))))))
(setq di (1+ di))
)
(setq AllType (mapcar 'car Datalist) Dtype '())
(while AllType
(setq Dtype (append Dtype (list (car AllType))))
(setq AllType (vl-remove (car AllType) AllType))
)
(setq ExportData '())
(while Dtype
(setq TypeI (car Dtype) xi 0 Tsum 0.0)
(while (< xi (length DataList))
(if (= (car (nth xi DataList)) TypeI) (setq Tsum (+ Tsum (atof (cadr (nth xi DataList))))))
(setq xi (1+ xi))
)
(setq ExportData (append ExportData (list (list TypeI Tsum))))
(setq Dtype (cdr Dtype))
)
ExportData
)
;======================================================================================================
(defun 2excel(ExportData / xlapp ex ex-wb nwb sheet cell exi coci Xchen Ychen)
(VL-LOAD-COM)
(setq xlapp (vlax-create-object "Excel.Application"))
(setq ex (vlax-put-property xlapp "Visible" T))
(setq ex-wb (vlax-get-property xlapp "Workbooks"))
(setq nwb (vlax-invoke-method ex-wb "add"))
(setq sheet (vlax-get-property nwb "ActiveSheet"))
(setq cell (vlax-get-property sheet "Cells"))
(setq exi 0)
(vlax-put-property cell "item" (1+ exi) 1 "LOAI")
(vlax-put-property cell "item" (1+ exi) 2 "TONG DAI")

(while (< exi (length ExportData))
(setq coci (nth exi ExportData))
(setq Xchen (nth 0 coci))
(setq Ychen (nth 1 coci))
(vlax-put-property cell "item" (+ exi 2) 1 Xchen)
(vlax-put-property cell "item" (+ exi 2) 2 ychen)
(setq exi (1+ exi))
)
(princ)
(princ)
)
;======================================================================================================
(defun 2txt(ExportData / Path txtFile file i coci Xchen Ychen)
(setq Path (getvar "DWGPREFIX"))
(setq txtFile (strcat Path "Summary.txt"))
(setq file (Open txtFile "w"))
(setq txi 0)
(write-line (strcat "LOAI" " " "TONG DAI") file)
(while (< txi (length ExportData))
(setq typi (nth txi ExportData))
(setq Xchen (nth 0 typi))
(setq Ychen (nth 1 typi))
(write-line (strcat Xchen " " (rtos Ychen 2 3)) file)
(setq txi (1+ txi))
)
(close file)
(startapp "Notepad" txtFile)
(princ)
(princ)
)
;======================================================================================================
(defun c:Csum(/ kw ExportData)
(setq ExportData (Summary))
(initget "E T")
(if (= keyx nil)
(progn
(setq kw (getkword (strcat "\nXu\U+1EA5t <T>: ")))
(if (= kw nil) (setq kw "T"))
)
(progn
(setq kw (getkword (strcat "\nXu\U+1EA5t <" keyx ">: ")))
(if (= kw nil) (setq kw keyx))
)
)
(setq keyx kw)
(cond
((= kw "T") (setq ssx (2txt ExportData)))
((= kw "E") (setq ssx (2excel ExportData)))
)
(princ)
(princ)
)

<p></p>
<p>Hề hề hề,</p>
<p>Đây là cái lisp mình chỉnh lại theo hướng các bác Tue_NV và Ketxu đã góp ý. Hy vọng nó sẽ nhanh hơn cái lisp cũ. Rất mong các bác test và cho ý kiến.</p>
<p></div>
<div> </div>
<div>@ bác chủ thớt: Theo ngu ý của mình thì có thể trong cái gọi là TOPO của bác nó không có đối tượng là Acad_proxy_entity...

<p></p>
<p>Hề hề hề,</p>
<p>Đây là cái lisp mình chỉnh lại theo hướng các bác Tue_NV và Ketxu đã góp ý. Hy vọng nó sẽ nhanh hơn cái lisp cũ. Rất mong các bác test và cho ý kiến.</p>
<p></div>
<div> </div>
<div>@ bác chủ thớt: Theo ngu ý của mình thì có thể trong cái gọi là TOPO của bác nó không có đối tượng là Acad_proxy_entity bác ạ. Đối tượng này chỉ khi xuất từ Topo sang Cad nó mới tạo thành. Bởi thế nên cái thằng ssget nó chả nhận được thằng cu tí nào cả.</div>
<div>Do mình chả biết cái chi về thằng Topo này nên chỉ đoán mò theo cái kết quả mà bác đưa ra. Trúng hay trật thì các bác đừng trách.</div>
<div>Nếu quả đúng vậy thì tại sao bác chủ thớt lại cứ nhất thiết phải chạy lisp trên nền Topo nhỉ?? Nếu chạy trong CAD rồi trả cái kết quả về Topo thì không được ư??? Mình cứ thiển nghĩ rằng nếu thằng Topo xuất được sang CAd thì ắt phải có cách xuất ngược từ CAd về Topo để xử lý.</div>
<div>Mặt khác cái đích cuối cùng bác cần là cái chi?? Nếu sử dụng cái kết quả của lisp này thì có vấn đề gì không thỏa mãn cho cái đích cuối cùng ấy. Hay chỉ là vấn đề bác không thích dùng do nó không chạy được với Topo???</div>
<div>Mình thì cho rằng cái cần là cái đích đó, đi bằng cách nào, làm bằng cách chi mà đạt được cái đích đó thì cho dù nó có hơi chậm cũng còn hơn ngồi chờ cách tối ưu thỏa mãn cái ý thích của mình mà chửa biết lúc nào có được.</div>
<div>Chừng nào bác có được cái tối ưu bác cần có thể bác hãy chia sẻ cái đó để anh em được học hỏi thêm chút chút bác nhé.</div>
<div>Chúc bác vui.</div>
<div> </div>
<div> </div>

Oki, lisp đã hoàn chỉnh, ae giao thông có thể dùng thoải mái roài. Hí hí e ở Bắc Ninh bác ah. Thank sờ kiu bác nhều

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196992&st=0&#entry196992
;; free lisp from cadviet.com
;;;...

Oki, lisp đã hoàn chỉnh, ae giao thông có thể dùng thoải mái roài. Hí hí e ở Bắc Ninh bác ah. Thank sờ kiu bác nhều

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196992&st=0&#entry196992
;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196822&st=0&#entry196822
;Kh&#235;i t&#185;o m&#233;t s&#232; th&#171;ng s&#232; cho v&#207; n&#243;t
;------------------------------------------------------
(defun C:knut ()
(setq hf (getreal "\nChieu cao text: "))
(command "dimstyle" "s" "Dimn" "dimstyle" "s" "Dran")
(command "-Style" "hoatfon" "hoatfon" hf "" "" "" "" "")
(command "-Layer" "n" "Text" "c" "4" "Text" "")
(command "-Layer" "n" "Dim" "c" "1" "DIm" "")
(command "-Layer" "n" "Khuat" "c" "4" "Khuat" "l" "Dashed" "Khuat" "")
(Princ)
)
;;;Chuong trinh chinh (Ve va thong ke cac yeu to cua duong cong)
(setq tlv (getint "\nNhap ty le ban ve nut 1/... :"))
(defun c:GN ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq sttdinh (getint "\nNhap so thu tu dinh :"))
(setq es (entsel "\nChon cung tron can ve:"))
(setq dbang (getpoint "\nChon vi tri dat bang thong ke:"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq tdt (car es)
dra (cadr es)
ent (entget tdt)
cen (cdr (assoc 10 ent))
goc1 (cdr (assoc 50 ent))
goc2 (cdr (assoc 51 ent))
bk (cdr (assoc 40 ent))
)
(setq td1 (polar cen goc1 bk)
td2 (polar cen goc2 bk)
)
(setq mid (list (/ (+ (car td1) (car td2)) 2) (/ (+ (cadr td1) (cadr td2)) 2) (caddr td1)))
(setq goc (angle cen mid))
(setq goctam (abs (- goc2 goc1)))
(if (< goctam pi)
(setq goct goctam)
(setq goct (- (* 2 pi) goctam))
)
(setq dtam (/ bk (cos (/ goct 2))))
(setq dinh (polar cen goc dtam))
(setq T (rtos (/ (* (distance dinh td1) tlv) 1000) 2 2)
P (rtos (/ (* (- dtam bk) tlv) 1000) 2 2)
K (rtos (/ (* (* goct bk) tlv) 1000) 2 2)
Ssbk (rtos (/ (* bk tlv) 1000) 2 2)
)
(command "-layer" "s" "khuat" "" ".line" td1 dinh td2 "")
(command "-layer" "s" "DIM" "" "Dimstyle" "" "Dimn")
(setq kckt (* 2.2 (getvar "dimtxt")) dkt1 (polar td1 goc1 kckt))
(command "DIMALIGNED" dinh td1 dkt1)
(setq dkt2 (polar td2 goc2 kckt))
(command "DIMALIGNED" dinh td2 dkt2)
(command "Dimstyle" "" "Dran" "DIMRADIUS" tdt dra "")
;V&#207; khung th&#232;ng k&#170; nut
;--------------------------------
(setq xb (+ (car dbang) (* 11 (getvar "textsize"))) yb (- (cadr dbang) (* 10.25 (getvar
"textsize"))) dbang2 (list xb yb (caddr dbang)) odbang (polar dbang (/ (* 3 pi) 4) (/
(getvar "textsize") 5)) odbang2 (polar dbang2 (- (* 2 pi) (/ pi 4)) (/ (getvar "textsize")
5)))
(command ".layer" "s" "text" "" ".rectang" odbang odbang2 ".rectang" dbang dbang2) (command
"change" "l" "" "p" "c" "1" "")
;X&#246; l&#253; b&#182;ng th&#232;ng k&#170;
;-----------------------------
(setq gockep (angtos (- pi goct) 1 4))
(setq Kiem1 (substr gockep 2 1) kiem2 (substr gockep 3 1) kiem3 (substr gockep 4 1))
(cond ((= kiem1 "d") (setq dau (substr gockep 1 1) cuoi (substr gockep 3))) ((= kiem2 "d")
(setq dau (substr gockep 1 2) cuoi (substr gockep 4))) ((= kiem3 "d") (setq dau (substr
gockep 1 3) cuoi (substr gockep 5)))
)
(setq gockep (strcat (strcat dau "%%d") cuoi))
;----------------------------
(setq nhan (rtos sttdinh 2 0))
(setq chugoc (strcat (strcat "A" nhan) (strcat "=" gockep)))
(setq chubk (strcat (strcat (strcat "R" nhan) (strcat "=" ssbk)) "m"))
(setq chutt (strcat (strcat (strcat "T" nhan) (strcat "=" T)) "m"))
(setq chup (strcat (strcat (strcat "P" nhan) (strcat "=" P)) "m"))
(setq chucd (strcat (strcat (strcat "K" nhan) (strcat "=" K)) "m"))
(setq dong1 (polar dbang (- (* 2 pi) (/ (* 9 pi) 24)) (* 1.75 (getvar "textsize")))
dong2 (polar dong1 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong3 (polar dong2 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong4 (polar dong3 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong5 (polar dong4 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
)
(command "-layer" "s" "Text" "" ".text" dong1 "" chugoc ".text" dong2 "" chubk ".text"
dong3 "" chutt ".text" dong4 "" chup ".text" dong5 "" chucd)
(setq tendinh (strcat "A" nhan))
(command ".text" dinh "" tendinh)
(command "insert" "nut" dinh "" "" "" )
(setvar "osmode" osm)
(setvar "cmdecho" cmd) (princ)
)

Ketxu chỉnh 1 tí code của bác Hạ cho dễ nhìn.
Khi dùng rtos đặc biệt chú ý tác dụng của biến DIMZIN

(defun C:test (/ e1 e2 e3 h1 h2 h3 pt ss1 ss2 val blk ssgetT prf) ;ketxu changed
(initget "y Y n N")
(setq prf (getkword "\nDoi dau :")
nm (getint "\nSo dau phay :")
blk (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
oDZ (getvar 'DiMZIN)

>>

Ketxu chỉnh 1 tí code của bác Hạ cho dễ nhìn.
Khi dùng rtos đặc biệt chú ý tác dụng của biến DIMZIN

(defun C:test (/ e1 e2 e3 h1 h2 h3 pt ss1 ss2 val blk ssgetT prf) ;ketxu changed
(initget "y Y n N")
(setq prf (getkword "\nDoi dau :")
nm (getint "\nSo dau phay :")
blk (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
oDZ (getvar 'DiMZIN)
)
(defun addmtext (blk str pt)(vla-addmtext blk (vlax-3d-point pt) 1 str))
(defun ssgetT (p h rg)
(ssname
(ssget "c" (polar p (* 1.25 pi) rg) (polar p (* 0.25 pi) rg) (list (cons 0 "TEXT") (cons 40 h) (cons 1 "~**"))) 0)
)
(defun val (d e)(cdr (assoc d (entget e))))
(setvar 'DIMZIN 0)
(mapcar '(lambda(x y)(set x (val 40 y)))
'(h1 h2 h3)
(mapcar '(lambda(x y)(set x (car (entsel y)))) '(e1 e2 e3) '("\nText lon mau :" "\nText be:" "\nText cham"))
)

(princ "\nChon tap hop cac Text dau cham...")
(foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "TEXT") (cons 40 h3) (cons 1 "."))))))
(vla-put-color
(addmtext blk
(rtos
(distof (setq str (strcat (if (= (strcase prf) "Y") "-")(val 1 (ssgetT (setq p (val 10 en)) h3 h3)) "." (val 1 (ssgetT p h2 h3)))))
2 nm)
(list (car p)(cadr p)(distof str))
)
1) ;So 1 la mau cua doi tuong
)
(setvar 'DIMZIN oDZ)
)