Mình đang tập tành mót LISP. Mặc định, mình đo theo mét, nếu không thích thì mình sẽ bỏ đi đơn vị. Hi vọng cái này đúng ý bạn:

(defun C:TL3 (/ L p1 p2 txtht pnt)
(while
(and
(setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
;;; (setq te (entget (car (entsel"\n Chon Text de gan ket qua...

Mình đang tập tành mót LISP. Mặc định, mình đo theo mét, nếu không thích thì mình sẽ bỏ đi đơn vị. Hi vọng cái này đúng ý bạn:

(defun C:TL3 (/ L p1 p2 txtht pnt)
(while
(and
(setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
;;; (setq te (entget (car (entsel"\n Chon Text de gan ket qua :")))
;;; te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
;;; (entmod te)
(setq pnt (getpoint "\nChon diem chen text:"))
(setq txtht (getdist (strcat "\nChieu cao text <" (rtos (getvar "textsize") 2 2) ">: ")))
(if (null txtht) (setq txtht (getvar "textsize")))
(command "text" "m" pnt txtht 0 (strcat (rtos(/ L 1000) 2 2) "m"))
)
)

Chủ topic không biết sử dụng annotative object và annotation scale mà Detaling.
Yêu cầu 1 thì chỉ đơn giản thế này thôi. mình viết qua để dùng tạm, bỏ qua bước kiểm tra điều kiện môi trường áp dụng.
@chủ topic: hãy đảm bảo khi dùng lệnh này viewport của bạn không bị khóa
(defun c:vz (/ zxp)
(if (setq zxp (getreal "- Nhap ty le zoom 1:"))
(command "zoom" (strcat...

Chủ topic không biết sử dụng annotative object và annotation scale mà Detaling.
Yêu cầu 1 thì chỉ đơn giản thế này thôi. mình viết qua để dùng tạm, bỏ qua bước kiểm tra điều kiện môi trường áp dụng.
@chủ topic: hãy đảm bảo khi dùng lệnh này viewport của bạn không bị khóa
(defun c:vz (/ zxp)
(if (setq zxp (getreal "- Nhap ty le zoom 1:"))
(command "zoom" (strcat "1/" (rtos zxp 2 0) "xp")))
(princ))
Ví dụ: Nếu muốn zoom viewport tỷ lệ 1:50xp thì bạn gõ lệnh và nhập 50 là ok

Bạn thêm 2 dòng vào như mình đã đánh dấu

(defun c:A()
(princ "\nCHAO cadviet")
(if (= Ty_le nil)
(progn
(initget (+ 1 2 4))
(print)
(print)
(setq Ty_le (getreal "\nXin a nhap ty le! : "))
)
)
(setq ntl (/ 1 Ty_le))
(setq tl2 (* ntl ntl))
(print)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap"...

Bạn thêm 2 dòng vào như mình đã đánh dấu

(defun c:A()
(princ "\nCHAO cadviet")
(if (= Ty_le nil)
(progn
(initget (+ 1 2 4))
(print)
(print)
(setq Ty_le (getreal "\nXin a nhap ty le! : "))
)
)
(setq ntl (/ 1 Ty_le))
(setq tl2 (* ntl ntl))
(print)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nem xin anh chon vung: "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(command "hatch" "ANSI31" 4 "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\n xin a chon diem: "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tl2))
;;(setq dtl (/ dtl 2.0))
(setq en (car (entsel "Thay cho so : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
(entmod elst)
(setq mau (getint "\nXin anh chon mau: "));; Dong viet them
(command "change" en "" "p" "COLOR" mau "" "") ;; Sua lai dong nay
; (print)
; (prompt (strcat "\nTotal area : " (rtos dtl 2 2)))
; (print)
; (setq pt2 (getpoint "\n Viet ra !: "))
; (command "text" pt2 "0" "2" (rtos dtl 4 2))
(setvar "OSMODE" oslast) ;; Dong viet them
);defun

Cám ơn bạn Ha đã hỗ trợ hết mình. Hôm nay mình có vđ này nhờ các bạn thử xem. Do đây kg phải là một ý tưởng bị bí nên mình kg đưa thành một chủ đề. Vđ thế này : Mình có down trên DD Cadviet một Lisp kg rõ của bạn nào (xin thứ lỗi), nó có chức năng tìm giao điểm của các đoạn thẳng (và nhiều loại đường khác) và đánh vào đó một Block, tuy nhiên, mình thay vào đó 1 point cho nó nhanh....

Cám ơn bạn Ha đã hỗ trợ hết mình. Hôm nay mình có vđ này nhờ các bạn thử xem. Do đây kg phải là một ý tưởng bị bí nên mình kg đưa thành một chủ đề. Vđ thế này : Mình có down trên DD Cadviet một Lisp kg rõ của bạn nào (xin thứ lỗi), nó có chức năng tìm giao điểm của các đoạn thẳng (và nhiều loại đường khác) và đánh vào đó một Block, tuy nhiên, mình thay vào đó 1 point cho nó nhanh. Hiện tại nó chạy với bv mình đưa lên dưới đấy mất 3'43'', bạn nào có thể sd Lisp này và nâng cấp sao cho nó có thể chạy dưới 20''. Xin các bạn thử xem, đây là một vđ cải thiện tốc độ. Cám ơn các bạn.

Đây là bản vẽ
http://www.cadviet.c...170_ttline2.dwg

Ngược lại, thậm chí còn liên quan chặt chẽ. Nếu bạn biết sử dụng và kết hợp tốt 3 yếu tố: Viewport scale - Object scale - Annotation scale thì bạn sẽ thấy việc sử dụng Annotative object tạo ra hiệu quả sử dụng tuyệt vời đến mức nào.

Cũng chỉ đơn giản là zoom scale viewport như trên thôi, nhưng khi ứng dụng cho Annotative object thì mình fải viết nó phức tạp như thế này:

>>

Ngược lại, thậm chí còn liên quan chặt chẽ. Nếu bạn biết sử dụng và kết hợp tốt 3 yếu tố: Viewport scale - Object scale - Annotation scale thì bạn sẽ thấy việc sử dụng Annotative object tạo ra hiệu quả sử dụng tuyệt vời đến mức nào.

Cũng chỉ đơn giản là zoom scale viewport như trên thôi, nhưng khi ứng dụng cho Annotative object thì mình fải viết nó phức tạp như thế này:

; 06. zoom theo t&#251; l&#214;
(defun C:VZ (/ zxp KC KC1 NAME PT vpObj tyle)
(if (setq zxp (getreal (TCVN3-Unicode "- Nh&#203;p t&#251; l&#214; zoom: 1:")))
(progn
(if (eq (vla-get-DisplayLocked (setq vpObj (vlax-ename->vla-object (acet-currentviewport-ename)))) :vlax-true) (vla-put-DisplayLocked vpObj :vlax-False))
(cond ((and (= (getvar "TILEMODE") 0) (> (getvar "CVPORT") 1))
(Add-ScaleList (setq tyle (strcat "1:" (rtos zxp 2 0))))(setvar "cannoscale" tyle)
(setq zxp (strcat "1/" (rtos zxp 2 0) "xp"))
(command "zoom" zxp))
((and (= (getvar "TILEMODE") 0) (= (getvar "CVPORT") 1))
(setq PT (cadr (grread 't 15)) KC 999999999999999999)
(foreach ssn (ss->list(ssget "c" (get-coordinate-screen "BR") (get-coordinate-screen "TL") '((0 . "VIEWPORT"))))
(if (> KC (setq KC1 (distance PT (dxf 10 ssn)))) (setq KC KC1 name ssn)))
(command "mspace")
(if name (setvar "cvport" (dxf 69 name)))
(vla-put-DisplayLocked (vlax-ename->vla-object name) :vlax-false)
(Add-ScaleList (setq tyle (strcat "1:" (rtos zxp 2 0)))) (setvar "cannoscale" tyle)
(setq zxp (strcat "1/" (rtos zxp 2 0) "xp"))
(command "zoom" zxp) (princ))
(t (Prompt (TCVN3-Unicode "** L&#214;nh n&#181;y ch&#216; &#174;&#173;&#238;c s&#246; d&#244;ng trong Layout **"))))))
(princ))
(defun Add-ScaleList ( tyle / dic lst)
(setq lst '("A0" "A1" "A2" "A3" "A4" "A5" "A6" "A7" "A8" "A9"
"B0" "B1" "B2" "B3" "B4" "B5" "B6" "B7" "B8" "B9"
"C0" "C1" "C2" "C3" "C4" "C5" "C6" "C7" "C8" "C9"
"D0" "D1" "D2" "D3" "D4" "D5" "D6" "D7" "D8" "D9"
"E0" "E1" "E2" "E3" "E4" "E5" "E6" "E7" "E8" "E9"
"F0" "F1" "F2" "F3" "F4" "F5" "F6" "F7" "F8" "F9"
"G0" "G1" "G2" "G3" "G4" "G5" "G6" "G7" "G8" "G9"))
(if (setq dic (dictsearch(namedobjdict) "ACAD_SCALELIST"))
(if (not (member Tyle (mapcar'(lambda(x)(cdr(assoc 300 (entget x)))) (dxf-etg-m 350 dic))))
(entmod (append dic (list (cons 3 (cadr (member (cdadr (reverse dic)) lst)))(cons 350 (entmakex (list '(0 . "SCALE")'(102 . "{ACAD_REACTORS")'(102 . "}")'(100 . "AcDbScale")'(70 . 0)(cons 300 tyle)'(140 . 1.0)(cons 141 (atoi (substr tyle 3 (strlen tyle))))'(290 . 0))))))))))

Lisp rtd đúng theo ý của mình nhưng text lại không tăng dần theo ý của mình. còn lệnh rt thì tăng dần nhưng text lại không nằm ở đường pl. bạn có thể sửa lại giúp mình được không bạn.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=42771&st=60
(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai...

Lisp rtd đúng theo ý của mình nhưng text lại không tăng dần theo ý của mình. còn lệnh rt thì tăng dần nhưng text lại không nằm ở đường pl. bạn có thể sửa lại giúp mình được không bạn.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=42771&st=60
(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(setq diemchuan (vlax-curve-getPointAtDist chondd 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist chondd chieudaicuver))
(setq chieudaitinh chieudaicuver)
(setq dautinh +)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituongtext)
(princ "\nChon doi tuong rai kem theo text :")
(setq ss (ssget))
(cond
((= ss nil) (setq thuchienrai raikieutextkokem))
((/= ss nil) (setq thuchienrai raikieutextcokem)))
(choncuver)
(chondiemxuatphat)
;(setq thuchienrai raikieutext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituongtext ()
(if (null congthem)(setq congthem "1"))
(setq ddd (entsel "\nChon text mau"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text mau"))
)
(setq sst (car ddd))
(setq DTTT (entget sst))
(setq NDTTT (cdr (assoc 1 DTTT)))
(Setq temp T)
(While temp
(setq dc (strcat "\nDon vi cong them la(" congthem "): "))
(Initget "D")
(setq str (getpoint dc))
(Cond
((= str "D") (setq congthem (getstring (strcat"\nDon vi cong them la <" congthem "> :"))))
(Progn
(Setq dc str)
(setq temp nil)
)
)
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +))
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
)
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))
(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T")
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raisoluongtinh))
((< tongdoan chieudaitinh)
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raikhoangcachcd))
((< chieudaidoan chieudaitinh)
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
(princ "\nChon doi tuong rai:")
(setq ss (ssget))
(cond
((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
((/= ss nil)
(setq dsl (sslength ss))
(cond
((= dsl 1)
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
(cond
((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
((/= KIEUDOITUONG "INSERT") (chondiemchuandoituong))
);ketthuccondxemblock
);kethucdsl1
((/= dsl 1) (chondiemchuandoituong))
);ketthuccondnho
);ketthucsetqdsl
);ketthuccondtong
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()
(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)
(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieukhongtext (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(setq L 0)
(setq M (sslength ss))
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil)
(setq L 0)
(setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p3)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)
)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;
(Defun raikieutextcokem (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext) (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiuatext copyquaytext) (setq copygiua copyquay))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieutextkokem (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext))
((/= quaykhong "K")(setq copygiuatext copyquaytext))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquaytext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq congthems (atoi congthem))
(setq DTDM (entlast))
(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)
(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAYtext (/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquaytext))
((/= p3 nil)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p3)

(setq congthems (atoi congthem))
(setq DTDM (entlast))
(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)
(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
)
)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAYtext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2 "")
(setq congthems (atoi congthem))
(setq DTDM (entlast))
(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)
(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;

Các bác PHAMTHANHBINH, LP_HAI và KETXU đã giúp bạn tới từng bước thật tỉ mỉ rồi
Nhưng nếu mới lập trình lisp sẽ còn nhiều khó khăn.
Với mình thường xem và copy code của các lisp rồi trộn nó với nhau để được lisp mình mong muốn
Lisp này mình chỉ cụ thể hóa ý tưởng của các bác đã nêu trên để bạn dễ hình dung hơn

; free lisp from cadviet.com
(defun c:ttext()

>>

Các bác PHAMTHANHBINH, LP_HAI và KETXU đã giúp bạn tới từng bước thật tỉ mỉ rồi
Nhưng nếu mới lập trình lisp sẽ còn nhiều khó khăn.
Với mình thường xem và copy code của các lisp rồi trộn nó với nhau để được lisp mình mong muốn
Lisp này mình chỉ cụ thể hóa ý tưởng của các bác đã nêu trên để bạn dễ hình dung hơn

; free lisp from cadviet.com
(defun c:ttext()
(command "undo" "be")
(command "cmdecho" 0)
(if (/= (setq sset (ssget "_I")) nil)
(setq hnd (ssname sset 0))
(setq hnd (car (entsel "\nDS> Chon text ban dau: "))) ;; Ham entsel de chon 1 doi tuong
)
(if (/= hnd nil)
(progn
(if (= "TEXT" (cdr (assoc 0 (entget hnd))))
(progn
(setq gtext (cdr(assoc 1 (entget hnd))))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget '((0 . "text"))))
(setq n (sslength ss))
(setq i 0)
(while (< i n)
(setq e (entget(ssname ss i)))
(setq e (subst (cons 1 gtext) (assoc 1 e) e))
(entmod e) ;; Thay noi dung cua doi tuong
(setq i (1+ i))
);; while
);progn
);;if
);;progn
);;if
(command "undo" "end")
(princ)
);;defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Chúc bạn vui vẻ với niềm vui lập trình lisp
P/s: Các bác đừng ném đá nhé

Viết lisp đạt tốc độ cao thì bao giờ cũng khó. Rất chờ đợi những sáng tạo xuất thần của bác. Nếu phân tích thì như bác Thai đã phân tích, và có thể bổ sung thêm một vài thứ nữa. Dù sao tôi vẫn thích những vấn đề mà bác đã đưa ra. Chỉ tiếc là nếu bác nói đề toán là "đố vui" hoặc "thảo luận" thì mọi việc sẽ nhẹ nhàng hơn.
Tôi cũng góp 1 cái (thay lời phân...

Viết lisp đạt tốc độ cao thì bao giờ cũng khó. Rất chờ đợi những sáng tạo xuất thần của bác. Nếu phân tích thì như bác Thai đã phân tích, và có thể bổ sung thêm một vài thứ nữa. Dù sao tôi vẫn thích những vấn đề mà bác đã đưa ra. Chỉ tiếc là nếu bác nói đề toán là "đố vui" hoặc "thảo luận" thì mọi việc sẽ nhẹ nhàng hơn.
Tôi cũng góp 1 cái (thay lời phân tích), giải đố để giải trí cho vui. Chạy trên bản vẽ bác gởi (#54), trên máy tui, trên cad2007, thì mất tầm 15".

em tìm khắp lisp xóa text point trùng nhau trên diễn đàn mình,
cũng có rất nhiều lisp có lệnh như Ftext, Ftext0. SXX.....nhưng không đúng ý em lắm,
mãi mới sưu tầm đc cái lisp này, em muốn chỉnh sửa chút để ứng dụng lisp được hiệu quả hơn,

lisp này khi gõ ''xoatext'' và chọn text thì lisp chuyển text cần xóa thành màu xanh.
giờ em muốn lisp xóa hẳn luôn thì sửa lisp trên như...

em tìm khắp lisp xóa text point trùng nhau trên diễn đàn mình,
cũng có rất nhiều lisp có lệnh như Ftext, Ftext0. SXX.....nhưng không đúng ý em lắm,
mãi mới sưu tầm đc cái lisp này, em muốn chỉnh sửa chút để ứng dụng lisp được hiệu quả hơn,

lisp này khi gõ ''xoatext'' và chọn text thì lisp chuyển text cần xóa thành màu xanh.
giờ em muốn lisp xóa hẳn luôn thì sửa lisp trên như thế nào ah. mong anh chị chỉ giúp.
trân trọng cảm ơn!

Hi NgaMy, lâu quá khg vào diễn đàn, thiep xin góp 1 lisp để giải trí, giải sầu một tí:

(defun c:cg (/ TapChon entlst lst tg Now Pstart Pend len r p1 p2 p3 p4
lstF ss)
(setq TapChon (ssget '((0 . "*LINE")))
entlst (ACET-SS-TO-LIST TapChon)
lst nil
)
(command "undo" "be")
(setvar "osmode" 0)
(foreach ent entlst
(setq Pstart...

Hi NgaMy, lâu quá khg vào diễn đàn, thiep xin góp 1 lisp để giải trí, giải sầu một tí:

(defun c:cg (/ TapChon entlst lst tg Now Pstart Pend len r p1 p2 p3 p4
lstF ss)
(setq TapChon (ssget '((0 . "*LINE")))
entlst (ACET-SS-TO-LIST TapChon)
lst nil
)
(command "undo" "be")
(setvar "osmode" 0)
(foreach ent entlst
(setq Pstart (vlax-curve-getStartPoint ent)
Pend (vlax-curve-getEndPoint ent)
)
(setq lst (append lst (list Pstart) (list Pend)))
)
(setq lst (ACET-LIST-REMOVE-DUPLICATES lst 0.01));
(setq len (length lst)
r 0.01)
(foreach Diem lst
(setq p1 (polar Diem 0 r)
p2 (polar Diem (/ pi 2) r)
p3 (polar Diem pi r)
p4 (polar Diem (/ (* 3 pi) 2) r)
lstF (list p1 p2 p3 p4)
)
(setq ss (ssget "F" lstF '((0 . "*LINE"))))
(if (and ss (> (sslength ss) 1))
(entmake (list (cons 0 "POINT") (cons 10 Diem)))
)
)
)
(command "undo" "en")
(princ len)
)

thời gian chạy 0.43"

Các bác ghi kết quả là 3 hay 5 giây, nhưng không có chuẩn thì sao mà biết là chậm hay nhanh ?!
(vì cấu hình máy tính của mỗi nguời khác nhau).

Góp vui với các bác :

(defun C:test(/ ipts lst obj ss)
(defun ss2lstObj (ss / n l e)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))) )

(if (and (setq ss(ssget...

Các bác ghi kết quả là 3 hay 5 giây, nhưng không có chuẩn thì sao mà biết là chậm hay nhanh ?!
(vì cấu hình máy tính của mỗi nguời khác nhau).

Góp vui với các bác :

(defun C:test(/ ipts lst obj ss)
(defun ss2lstObj (ss / n l e)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))) )

(if (and (setq ss(ssget "_A"(list (cons 0 "LINE"))))
(> (sslength ss)1))
(progn
(setq start (getvar "millisecs"))
(setq lst (ss2lstObj ss) )
(while (> (length lst)1)
(setq obj (car lst) lst (cdr lst))
(foreach e lst
(if (setq iPts (vlax-Invoke obj "IntersectWith" e 0))
(entmake (list (cons 0 "POINT") (cons 10 iPts))) )))
(princ (/(- (getvar "millisecs") start)1000.0)) (princ " giay.")))
(princ) )