Jump to content
InfoFile
Tác giả: Chiron
Bài viết gốc: 187387
Tên lệnh: tl3
Đo khoảng cách hai điểm và ghi kết quả ra nơi minh chọn
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"))
)
)

<<

Filename: 187387_tl3.lsp
Tác giả: Thaistreetz
Bài viết gốc: 203199
Tên lệnh: vz
Lisp tạo tỷ lệ cho Viewport và Lisp Copy base point.
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
<<

Filename: 203199_vz.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 203250
Tên lệnh: gdd
"[Yêu cầu] Nhờ viết Lisp ghi chiều dài - độ dốc, hướng dốc

Hề hề hề,
Xin lỗi vì bạn phải đợi lâu.Vừa qua mình cũng hơi bận nên không đọc được yêu cầu của bạn.
Đây là cái mình đã sửa lại từ cái lisp cũ, không biết đã đúng với cái bạn yêu cầu hay chưa. Nếu chưa xin đừng ngại nói rõ chỗ chưa được để mình ngâm tiếp.

Chúc bạn luôn vui.

Filename: 203250_gdd.lsp
Tác giả: Tue_NV
Bài viết gốc: 203272
Tên lệnh: vetron1 vetron2
Cách tạo hàm con với số lượng đối số thay đổi.


Đây anh:

Filename: 203272_vetron1_vetron2.lsp
Tác giả: makhongbietnoi
Bài viết gốc: 10008
Tên lệnh: chbd
Table trong Cad2008

Thank you very much!

Filename: 10008_chbd.lsp
Tác giả: ketxu
Bài viết gốc: 203332
Tên lệnh: mat
Cách thay đổi giá trị cho 1 đối tượng bằng Lisp
Ví dụ cho yêu cầu của bạn :

;Neu chi chon Text la cac doi tuong un-nested thi su dung ssget de thao tac 1 lan, doi tuong goc la doi tuong dau cua ssget
(defun c:mat ()
(setq x (cdr (assoc 1 (entget (ssname (ssget '((0 . "*TEXT"))) 0)))))
(vlax-for txt (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(vla-put-textstring txt x)
)
)

Filename: 203332_mat.lsp
Tác giả: mathan
Bài viết gốc: 203242
Tên lệnh: a
lisp Đo diện tích(a)
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

<<

Filename: 203242_a.lsp
Tác giả: TRUNGNGAMY
Bài viết gốc: 203360
Tên lệnh: chengiao
[Yêu cầu] Lisp phân nhỏ tập hợp chọn bằng cách chia ô

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
<<

Filename: 203360_chengiao.lsp
Tác giả: Thaistreetz
Bài viết gốc: 203203
Tên lệnh: vz
Lisp tạo tỷ lệ cho Viewport và Lisp Copy base point.


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))))))))))

<<

Filename: 203203_vz.lsp
Tác giả: nguyentienthanhddksct
Bài viết gốc: 194066
Tên lệnh: rdt dtd rt rtd
Lisp rải đối tượng theo đơờng dẩn.


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)
)
;;;;;;;;;;;;;;


<<

Filename: 194066_rdt_dtd_rt_rtd.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 194030
Tên lệnh: acl acl2
Hỏi về cách vẽ 1 cung có kích thước chính xác.

Hề hề hề,
Tiện tay mình chỉnh luôn cái lisp của bác Hoành để bạn tùy nghi lựa chọn. Lệnh chạy là acl2.


Chúc bạn vui và hy vọng bạn sẽ hài lòng khi xài các lisp trên.

Filename: 194030_acl_acl2.lsp
Tác giả: ketxu
Bài viết gốc: 129285
Tên lệnh: m2g
move đối tượng vào giao điểm của 2 đường ntn?
Chắc giống ntn : bạn chọn đối tượng, chọn basepoint, sau đó kick 4 điểm theo thứ tự 2 điểm thuộc đường 1, 2 điểm thuộc đường 2 nhé

Filename: 129285_m2g.lsp
Tác giả: mathan
Bài viết gốc: 203315
Tên lệnh: ttext
Cách thay đổi giá trị cho 1 đối tượng bằng Lisp
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é :ph34r:
<<

Filename: 203315_ttext.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 203443
Tên lệnh: ha
Lisp phân nhỏ tập hợp chọn bằng cách chia ô
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".

<<

Filename: 203443_ha.lsp
Tác giả:
Bài viết gốc: 0
Tên lệnh: chbd

Filename: 10013_chbd.lsp
Tác giả: minh_trungtq
Bài viết gốc: 203451
Tên lệnh: xoatext
Nhờ sửa lisp xóa text point!
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!





<<

Filename: 203451_xoatext.lsp
Tác giả: thiep
Bài viết gốc: 203460
Tên lệnh: cg
Lisp phân nhỏ tập hợp chọn bằng cách chia ô

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"
<<

Filename: 203460_cg.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 203483
Tên lệnh: ha
offset tự động
Lisp offset tất cả các đối tượng kín được chọn vào phía bên trong đối tượng, với cùng 1 khoảng cách offset.

Filename: 203483_ha.lsp
Tác giả: gia_bach
Bài viết gốc: 203510
Tên lệnh: test
Lisp phân nhỏ tập hợp chọn bằng cách chia ô
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) )

<<

Filename: 203510_test.lsp
Tác giả: phamngoctukts
Bài viết gốc: 111446
Tên lệnh: enc dec
chuyển chữ thành số

Lisp lỗi rồi bạn ơi không chạy được. Còn nếu bạn muốn mã hoá text thì code đây (cái này không nhớ của bác nào viết hình như của bác Tue_VN hày Gia_bach ý)

Filename: 111446_enc_dec.lsp

Trang 95/308

95