Jump to content
InfoFile
Tác giả: ketxu
Bài viết gốc: 193908
Tên lệnh: test
Lisp lọc các số sau chữ L, rồi tính tổng.
^^ Fixed

(defun c:test()
(alert (vl-princ-to-string
(apply '+
(mapcar '(lambda(x)(atof (vl-string-left-trim tmp (acet-dxf 1 (entget x)))))
(acet-ss-to-list (ssget (list (cons 0 "TEXT")(cons 1 (setq tmp (strcat "D" (itoa (getint "\nD : ")) "`,L#*"))))))
)))))

Filename: 193908_test.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 193880
Tên lệnh: ha
Lisp lọc các số sau chữ L, rồi tính tổng.

Thử thêm cái này cho vui luôn:

Filename: 193880_ha.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 21783
Tên lệnh: acl
Hỏi về cách vẽ 1 cung có kích thước chính xác.


Cái này em cũng ngồi giải nát óc mà không ra. Search mỏi tay thì được phương pháp giải bài toán:
f(x) = sin(x) - kx = 0.
Nhưng người ta cũng phải sử dụng phương pháp lặp Newton để giải. Bài gốc (bằng tiếng Anh) ở đây:
http://mathforum.org/dr.math/faq/faq.circle.segment.html#n1

Xin mô tả lại phương pháp này cho mọi người (cũng lặp giống pp của bác ssg):

Khởi tạo:...
>>

Cái này em cũng ngồi giải nát óc mà không ra. Search mỏi tay thì được phương pháp giải bài toán:
f(x) = sin(x) - kx = 0.
Nhưng người ta cũng phải sử dụng phương pháp lặp Newton để giải. Bài gốc (bằng tiếng Anh) ở đây:
http://mathforum.org/dr.math/faq/faq.circle.segment.html#n1

Xin mô tả lại phương pháp này cho mọi người (cũng lặp giống pp của bác ssg):

Khởi tạo: X0 = sqrt(6-6k).
Công thức truy hồi: Xn+1 = Xn - (sin(Xn)-kXn)/(cos(Xn)-k).
Khi n tiến đến vô tận thì Xn tiến về giá trị kết quả.

Về phương diện tin học, ta sẽ lặp công thức cho đến lúc nào hiệu của Xn và Xn+1 bé hơn sai số mong muốn thì dừng lặp.

Đoạn code của bác ssg trở thành:

<<

Filename: 21783_acl.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 193946
Tên lệnh: ha
Lisp lọc các số sau chữ L, rồi tính tổng.


Nhiều khi nói ra thì hơi quê (mà quê thiệt!): tôi rất sợ dùng 3 hàm: vl-string-trim, vl-string-left-trim, vl-string-right-trim, vì cú pháp nó dễ nhầm lẫn.
Nhân tiện, chơi luôn cái lisp tính chung cho các loại đường kính luôn (cầu mong nó không lỗi!)

Filename: 193946_ha.lsp
Tác giả: Thaistreetz
Bài viết gốc: 194027
Tên lệnh: vv
Nhờ viết lisp chia màn hình (VPort)



Tỷ lệ 4/9 và 5/9 để phân chia màn hình chính và phụ không hợp lý lắm. Tại vì bạn phải thao tác bằng lệnh của cad nên chỉ tạo được tỷ lệ này là điều dễ hiểu.

Mình đề xuất tỷ lệ 2/5 và 3/5 để tăng kích thước màn hình chính thêm 1 chút nữa.



;;; Copyright 2011 Thaistreetz from cadviet.com

(defun C:VV (/ get-coordinate-screen TS:zoom PT1 PT2)
>>


Tỷ lệ 4/9 và 5/9 để phân chia màn hình chính và phụ không hợp lý lắm. Tại vì bạn phải thao tác bằng lệnh của cad nên chỉ tạo được tỷ lệ này là điều dễ hiểu.

Mình đề xuất tỷ lệ 2/5 và 3/5 để tăng kích thước màn hình chính thêm 1 chút nữa.



;;; Copyright 2011 Thaistreetz from cadviet.com

(defun C:VV (/ get-coordinate-screen TS:zoom PT1 PT2)
(defun get-coordinate-screen (coner / Y1 X1)
(cond ((= (strcase coner) "TL")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar"viewsize")))) pi (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))))
((= (strcase coner) "TR")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar"viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))))
((= (strcase coner) "BL")
(polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar"viewsize")))) pi (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))))
((= (strcase coner) "BR")
(polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar"viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))))))
(defun TS:zoom (pt1 pt2) (vlax-invoke *acad-object* 'zoomwindow pt1 pt2))
(command "propertiesclose")
(if (= (length (vports)) 1)
(progn
(if (not(tblsearch "vport" "ThaistreetzView")) (progn
(entmakex '((0 . "VPORT")(100 . "AcDbSymbolTableRecord")(100 . "AcDbViewportTableRecord")(2 . "ThaistreetzView")
(70 . 0)
(10 0.0 0.0) (11 0.6 1.0)
(13 0.0 0.0 0.0)(14 0.5 0.5 0.0)(15 0.5 0.5 0.0)
(16 0.0 0.0 1.0)(17 0.0 0.0 0.0)
(41 . 0.974843)
(42 . 50.0) (43 . 0.0) (44 . 0.0)
(50 . 0.0) (51 . 0.0)
(71 . 0) (72 . 1000) (73 . 1) (74 . 3) (75 . 0) (76 . 0) (77 . 0) (78 . 0)
(281 . 0) (65 . 1)
(110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0)
(79 . 0) (146 . 0.0)
(60 . 2) (61 . 5)
(292 . 1) (282 . 1)
(141 . 0.0) (142 . 0.0)
(63 . 250) (421 . 3355443)))
(entmakex '((0 . "VPORT") (100 . "AcDbSymbolTableRecord") (100 . "AcDbViewportTableRecord") (2 . "ThaistreetzView")
(70 . 0)
(10 0.6 0.0 0.0)(11 1.0 1.0 0.0)
(13 0.0 0.0) (14 0.5 0.5) (15 0.5 0.5)
(16 0.0 0.0 1.0) (17 0.0 0.0 0.0)
(41 . 0.973617)
(42 . 50.0) (43 . 0.0) (44 . 0.0)
(50 . 0.0) (51 . 0.0)
(71 . 0) (72 . 1000) (73 . 1) (74 . 3) (75 . 0) (76 . 0) (77 . 0) (78 . 0)
(65 . 1)
(110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0)
(79 . 0) (146 . 0.0)
(60 . 2) (61 . 5)
(292 . 1) (282 . 1)
(141 . 0.0) (142 . 0.0)
(63 . 250) (421 . 3355443)))))
(setq PT1 (get-coordinate-screen "TL") PT2 (get-coordinate-screen "BR"))
(vl-cmdf "vports" "r" "ThaistreetzView")
(ts:zoom pt1 pt2)
(setvar "cvport" 3)
(ts:zoom pt1 pt2))
(vl-cmdf "vports" "si"))
(princ))


Cả 2 lệnh bật và tắt chế độ chia màn hình được dùng chung 1 lệnh là VV
Nếu không ưng với tỷ lệ của mình thì bạn sửa 2 dòng này:

(10 0.0 0.0) (11 0.6 1.0) -> (10 0.0 0.0) (11 0.5555 1.0) (hoặc 0.44445 = 4/9) <= đây là kích thước màn hình bên trái

(10 0.6 0.0 0.0)(11 1.0 1.0 0.0) -> (10 0.5555 0.0 0.0)(11 1.0 1.0 0.0) (hoặc 0.44445) <= đây là kích thước màn hình bên phải

Với quy tắc trên, bạn có thể chia theo bất kỳ tỷ lệ nào mà bạn muốn
<<

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

Hề hề hề,
Đây là code của bác SSG mình sửa lại chút chút theo yêu cầu của bạn. Lệnh vẽ là acl1 khác chút chút với lệnh acl của bác SSG. Ưu nhược điểm của nó thì bạn đọc các bài post phía trên sẽ hiểu.

Filename: 194024_arl_acl_acl1.lsp
Tác giả: nguyentienthanhddksct
Bài viết gốc: 194067
Tên lệnh: rdt dtd rt rtd
Lisp copy text tăng dần theo đường pl,arc,line


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.
đây là lsp đó:

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


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.
đây là lsp đó:

;; 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: 194067_rdt_dtd_rt_rtd.lsp
Tác giả: ketxu
Bài viết gốc: 194090
Tên lệnh: vv
Nhờ viết lisp chia màn hình (VPort)
Bác Thái hứng thú với các bài toán có cái Screen nhỉ ^^
Theo e thì nâng lên 1 tẹo nữa là dễ xài ngay :

(defun C:VV (/ get-coordinate-screen TS:zoom PT1 PT2)
(defun get-coordinate-screen (coner / Y1 X1)
(cond ((= (strcase coner) "TL")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar "viewsize")))) pi (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase...
>>
Bác Thái hứng thú với các bài toán có cái Screen nhỉ ^^
Theo e thì nâng lên 1 tẹo nữa là dễ xài ngay :

(defun C:VV (/ get-coordinate-screen TS:zoom PT1 PT2)
(defun get-coordinate-screen (coner / Y1 X1)
(cond ((= (strcase coner) "TL")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar "viewsize")))) pi (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase coner) "TR")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar "viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase coner) "BL")
(polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar "viewsize")))) pi (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase coner) "BR")
(polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar "viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))))
(defun TS:zoom (pt1 pt2) (vlax-invoke (vlax-get-acad-object) 'zoomwindow pt1 pt2))
(command "propertiesclose")
(setq PT1 (get-coordinate-screen "TL") PT2 (get-coordinate-screen "BR") x (abs (- (car pt1)(car pt2))))
(if (= (length (vports)) 1)
(progn
(or tl (setq tl (/ (- (car (getpoint "\nPart :")) (car pt1)) x)))
(if (not(tblsearch "vport" "ThaistreetzView")) (progn
(entmakex (append '((0 . "VPORT")(100 . "AcDbSymbolTableRecord")(100 . "AcDbViewportTableRecord")(2 . "ThaistreetzView")
(70 . 0)
(10 0.0 0.0)
(13 0.0 0.0 0.0)(14 0.5 0.5 0.0)(15 0.5 0.5 0.0)
(16 0.0 0.0 1.0)(17 0.0 0.0 0.0)
(41 . 0.974843)
(42 . 50.0) (43 . 0.0) (44 . 0.0)
(50 . 0.0) (51 . 0.0)
(71 . 0) (72 . 1000) (73 . 1) (74 . 3) (75 . 0) (76 . 0) (77 . 0) (78 . 0)
(281 . 0) (65 . 1)
(110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0)
(79 . 0) (146 . 0.0)
(60 . 2) (61 . 5)
(292 . 1) (282 . 1)
(141 . 0.0) (142 . 0.0)
(63 . 250) (421 . 3355443))(list (cons 11 (list tl 1.0)))))
(entmakex (append '((0 . "VPORT") (100 . "AcDbSymbolTableRecord") (100 . "AcDbViewportTableRecord") (2 . "ThaistreetzView")
(70 . 0)
(11 1.0 1.0 0.0)
(13 0.0 0.0) (14 0.5 0.5) (15 0.5 0.5)
(16 0.0 0.0 1.0) (17 0.0 0.0 0.0)
(41 . 0.973617)
(42 . 50.0) (43 . 0.0) (44 . 0.0)
(50 . 0.0) (51 . 0.0)
(71 . 0) (72 . 1000) (73 . 1) (74 . 3) (75 . 0) (76 . 0) (77 . 0) (78 . 0)
(65 . 1)
(110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0)
(79 . 0) (146 . 0.0)
(60 . 2) (61 . 5)
(292 . 1) (282 . 1)
(141 . 0.0) (142 . 0.0)
(63 . 250) (421 . 3355443))(list (cons 10 (list tl 0.0 0.0)))))
))
(vl-cmdf "vports" "r" "ThaistreetzView")
(ts:zoom pt1 pt2)
(setvar "cvport" 3)
(ts:zoom pt1 pt2))
(vl-cmdf "vports" "si"))
(princ))

<<

Filename: 194090_vv.lsp
Tác giả: Thaistreetz
Bài viết gốc: 194097
Tên lệnh: vv
Nhờ viết lisp chia màn hình (VPort)
hà hà. ketxu giải quyết vấn đề đơn giản mà hiệu quả. Cứ thấy thế nào vừa mắt là chơi, đỡ fải lăn tăn tỷ lệ.
Đã nâng thì nâng cho tới z luôn nhé. bỏ thằng "ThaistreetzView" kia đi khi không dùng nó nữa. như thế sẽ mềm dẻo hơn cho nhu cầu sử dụng

(defun C:VV (/ get-coordinate-screen TS:zoom PT1 PT2 tl)
(defun get-coordinate-screen (coner / Y1 X1)
(cond ((= (strcase coner)...
>>
hà hà. ketxu giải quyết vấn đề đơn giản mà hiệu quả. Cứ thấy thế nào vừa mắt là chơi, đỡ fải lăn tăn tỷ lệ.
Đã nâng thì nâng cho tới z luôn nhé. bỏ thằng "ThaistreetzView" kia đi khi không dùng nó nữa. như thế sẽ mềm dẻo hơn cho nhu cầu sử dụng

(defun C:VV (/ get-coordinate-screen TS:zoom PT1 PT2 tl)
(defun get-coordinate-screen (coner / Y1 X1)
(cond ((= (strcase coner) "TL")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar "viewsize")))) pi (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase coner) "TR")
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar "viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase coner) "BL")
(polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar "viewsize")))) pi (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))
((= (strcase coner) "BR")
(polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar "viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))))))
(defun TS:zoom (pt1 pt2) (vlax-invoke (vlax-get-acad-object) 'zoomwindow pt1 pt2))
(command "propertiesclose")
(setq PT1 (get-coordinate-screen "TL") PT2 (get-coordinate-screen "BR") x (abs (- (car pt1)(car pt2))))
(if (= (length (vports)) 1)
(progn
(setq tl (/ (- (car (getpoint "\nPart :")) (car pt1)) x))
(if (not(tblsearch "vport" "ThaistreetzView")) (progn
(entmakex (append '((0 . "VPORT")(100 . "AcDbSymbolTableRecord")(100 . "AcDbViewportTableRecord")(2 . "ThaistreetzView")
(70 . 0)
(10 0.0 0.0)
(13 0.0 0.0 0.0)(14 0.5 0.5 0.0)(15 0.5 0.5 0.0)
(16 0.0 0.0 1.0)(17 0.0 0.0 0.0)
(41 . 0.974843)
(42 . 50.0) (43 . 0.0) (44 . 0.0)
(50 . 0.0) (51 . 0.0)
(71 . 0) (72 . 1000) (73 . 1) (74 . 3) (75 . 0) (76 . 0) (77 . 0) (78 . 0)
(281 . 0) (65 . 1)
(110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0)
(79 . 0) (146 . 0.0)
(60 . 2) (61 . 5)
(292 . 1) (282 . 1)
(141 . 0.0) (142 . 0.0)
(63 . 250) (421 . 3355443))(list (cons 11 (list tl 1.0)))))
(entmakex (append '((0 . "VPORT") (100 . "AcDbSymbolTableRecord") (100 . "AcDbViewportTableRecord") (2 . "ThaistreetzView")
(70 . 0)
(11 1.0 1.0 0.0)
(13 0.0 0.0) (14 0.5 0.5) (15 0.5 0.5)
(16 0.0 0.0 1.0) (17 0.0 0.0 0.0)
(41 . 0.973617)
(42 . 50.0) (43 . 0.0) (44 . 0.0)
(50 . 0.0) (51 . 0.0)
(71 . 0) (72 . 1000) (73 . 1) (74 . 3) (75 . 0) (76 . 0) (77 . 0) (78 . 0)
(65 . 1)
(110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0)
(79 . 0) (146 . 0.0)
(60 . 2) (61 . 5)
(292 . 1) (282 . 1)
(141 . 0.0) (142 . 0.0)
(63 . 250) (421 . 3355443))(list (cons 10 (list tl 0.0 0.0)))))))
(vl-cmdf "vports" "r" "ThaistreetzView")
(ts:zoom pt1 pt2)
(setvar "cvport" 3)
(ts:zoom pt1 pt2))
(progn
(vl-cmdf "vports" "si")
(vl-cmdf "vports" "d" "ThaistreetzView")))
(princ))

<<

Filename: 194097_vv.lsp
Tác giả: ketxu
Bài viết gốc: 194081
Tên lệnh: test
Lisp copy text tăng dần theo đường pl,arc,line
Code cực nhanh và ẩu, theo hình bạn ấy post , k theo lời OP nói (vì k giống nhau ^^), nhưng bạn có thể bắt đầu từ đây :

(defun c:test()(vl-load-com)
(setq objPath (vlax-ename->vla-object (car (entsel "\nPath:")))
len (vlax-curve-getDistAtParam objPath (vlax-curve-getEndParam objPath))
objTxt (vlax-ename->vla-object (car (entsel "\nText:")))
basePnt (vlax-get objTxt 'InsertionPoint)
num...
>>
Code cực nhanh và ẩu, theo hình bạn ấy post , k theo lời OP nói (vì k giống nhau ^^), nhưng bạn có thể bắt đầu từ đây :

(defun c:test()(vl-load-com)
(setq objPath (vlax-ename->vla-object (car (entsel "\nPath:")))
len (vlax-curve-getDistAtParam objPath (vlax-curve-getEndParam objPath))
objTxt (vlax-ename->vla-object (car (entsel "\nText:")))
basePnt (vlax-get objTxt 'InsertionPoint)
num (atof (vla-get-textstring objTxt))
incNum (getreal "\nGia so :")
incDis (getdist "\nDist:")
i -1
)
(while (< (setq dis (* (setq i (1+ i)) incDis)) len)
(vla-put-textstring (setq tmp (vlax-invoke objTxt 'Copy)) (rtos (+ num (* i incNum)) 2 0))
(vlax-invoke tmp 'Move basePnt (vlax-curve-getPointAtDist objPath dis))
)
)

<<

Filename: 194081_test.lsp
Tác giả: nguyentienthanhddksct
Bài viết gốc: 194076
Tên lệnh: rdt dtd rt rtd
Lisp copy text tăng dần theo đường pl,arc,line
Lisp này đã đúng yêu cầu của mình lệnh rtd chỉ copy ko tăng dần, nhờ mọi người sửa lại tăng dần cho minh.
thanks



;; 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...
>>
Lisp này đã đúng yêu cầu của mình lệnh rtd chỉ copy ko tăng dần, nhờ mọi người sửa lại tăng dần cho minh.
thanks



;; 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: 194076_rdt_dtd_rt_rtd.lsp
Tác giả: NguyenNgocSon
Bài viết gốc: 194124
Tên lệnh: dc
viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo
Xin phép Ketxu. Mình sửa thêm cái chỗ cho thêm tỷ lệ vào cho bạn @svxd và hugo.

Thú thực là không am hiểu code lisp từ đầu nên cũng thi thoảng sửa 1 hai chỗ đơn giản thôi. Mong các bác hiểu cho, có thời gian cũng tìm hiểu được.

Cám ơn @Ketxu lisp rất hay.


;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>
Xin phép Ketxu. Mình sửa thêm cái chỗ cho thêm tỷ lệ vào cho bạn @svxd và hugo.

Thú thực là không am hiểu code lisp từ đầu nên cũng thi thoảng sửa 1 hai chỗ đơn giản thôi. Mong các bác hiểu cho, có thời gian cũng tìm hiểu được.

Cám ơn @Ketxu lisp rất hay.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=56086&pid=171947&st=0&#entry171947
(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
;Gan gia tri goc
(if (not k0) (setq k0 1));;gan gia tri goc
(setq k (getreal (strcat "\n Nhap ty le cua ban ve:1/" (rtos k0 2 0) "")));Nhap ty le ban ve
(if (not k) (setq k k0) (setq k0 k))
(defun dowith(lstSS / lstSS en str)
(cond ((setq en (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
(setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
)
)
(cons en str)
)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq lstSS (acet-ss-to-list (setq ss (ssget)))
obj (car (setq en (dowith lstSS)))
str (cdr en)
p1 (getpoint "\nDiem goc :")
eL (entlast)
oDz (getvar "Dimzin")
)
(setvar "DIMZIN" 0)
(while (setq p2 (getpoint p1 "\nDiem den :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq Txt1 (car (dowith listName))
eL (entlast)
)
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) k))) 0) "+")
((= num 0) "%%p")
(T "")
)
(rtos num 2 2));So chu so dau dau ;
)
)
(setvar "DIMZIN" oDZ)
)



<<

Filename: 194124_dc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 131517
Tên lệnh: chla
Nhờ viết lisp dọn mặt bằng siêu tốc

Bạn dùng thử cái này coi sao. Với các dim mình chưa giải quyết do chưa hiểu hết, cần tìm hiểu thêm. Với các block, mặc dù mình đã sử dụng phép đệ quy nhưng không hiểu vì sao vẫn chưa triệt để được. Có lẽ các block của bạn còn phức tạp hơn cái mình nghĩ chăng. Hy vọng nó sẽ giúp bạn được phần nào trong công việc.

Có gì cần bổ sung bạn cứ nói nhé. Phần về dim mình...
>>

Bạn dùng thử cái này coi sao. Với các dim mình chưa giải quyết do chưa hiểu hết, cần tìm hiểu thêm. Với các block, mặc dù mình đã sử dụng phép đệ quy nhưng không hiểu vì sao vẫn chưa triệt để được. Có lẽ các block của bạn còn phức tạp hơn cái mình nghĩ chăng. Hy vọng nó sẽ giúp bạn được phần nào trong công việc.

Có gì cần bổ sung bạn cứ nói nhé. Phần về dim mình sẽ bổ sung sau khi ngâm cứu ra.
<<

Filename: 131517_chla.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 131686
Tên lệnh: chdim
Nhờ viết lisp dọn mặt bằng siêu tốc

Gửi bạn cái lisp dùng để chuyển các đối tượng Dim trên bản vẽ về cùng lớp Architech và có màu là 8. Việc ghép lisp này với lisp trước mình chưa làm được nên bạn có thể nghiên cứu để tự ghép hoặc dùng kết hợp (phải gõ hai lệnh lisp).

Chúc bạn vui.

Filename: 131686_chdim.lsp
Tác giả: ketxu
Bài viết gốc: 194220
Tên lệnh: kmm
Giúp viết lisp chuyển tất cả các đối tượng về 1 layer
Nguyên văn nó như thế này :

(defun c:kmm(/ ss sss doc Util ent)
(vl-load-com)
(if (not (tblsearch "LAYER" "LAYERCHUNG"))
(command "Layer" "N" "LAYERCHUNG" "S" "LAYERCHUNG" "")
)
(setq ss (ssget "X" (list (cons -4 "<not") (cons 8 "LAYERCHUNG")(cons -4 "not>"))))
(setq doc (vla-get-activeDocument...
>>
Nguyên văn nó như thế này :

(defun c:kmm(/ ss sss doc Util ent)
(vl-load-com)
(if (not (tblsearch "LAYER" "LAYERCHUNG"))
(command "Layer" "N" "LAYERCHUNG" "S" "LAYERCHUNG" "")
)
(setq ss (ssget "X" (list (cons -4 "<not") (cons 8 "LAYERCHUNG")(cons -4 "not>"))))
(setq doc (vla-get-activeDocument (vlax-get-acad-object)))
(vlax-for x (setq sss (vla-get-ActiveSelectionSet doc))
(setq ent (vlax-vla-object->ename x))

(if (= (assoc 62 (entget ent)) nil)
(setq ent_cont (entget(tblobjname "LAYER" (cdr(assoc 8 (entget ent))))))
(setq ent_cont (entget ent))
)
(vlax-put x 'Color (cdr(assoc 62 ent_cont)))
(if (= (assoc 6 (entget ent)) nil)
(setq ent_cont (entget(tblobjname "LAYER" (cdr(assoc 8 (entget ent))))))
(setq ent_cont (entget ent))
)
(vlax-put x 'Linetype (cdr(assoc 6 ent_cont)))
(vlax-put x 'layer "LAYERCHUNG")
)
(vla-delete sss)
(alert "\n Da chuyen tat ca thanh LAYERCHUNG")
(princ)
)

<<

Filename: 194220_kmm.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 194244
Tên lệnh: ha
Lisp chọn tập hợp đối tượng gần nhất được sinh ra bởi 1 lênh.

Có phải tương tự cái này không?

Filename: 194244_ha.lsp
Tác giả: nguyentienthanhddksct
Bài viết gốc: 194296
Tên lệnh: tc
viết lisp di chuyển các text vào giữa vòng tròn


Đây bạn:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=22849
(defun C:TC (/ Txt PTxt PTX SS i prmt DK TEMP_JTF DCL_ID DCL_JTF)
(setq SS (ssget "I" '((0 . "TEXT"))) i 0)
(command "undo" "begin")
(setvar "cmdecho" 0)
(if (not JTF-T) (setq JTF-T (list 0 1 0)))
(if (= (cadr JTF-T) 1)
(setq prmt...
>>


Đây bạn:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=22849
(defun C:TC (/ Txt PTxt PTX SS i prmt DK TEMP_JTF DCL_ID DCL_JTF)
(setq SS (ssget "I" '((0 . "TEXT"))) i 0)
(command "undo" "begin")
(setvar "cmdecho" 0)
(if (not JTF-T) (setq JTF-T (list 0 1 0)))
(if (= (cadr JTF-T) 1)
(setq prmt "Text to Center")
(if (= (caddr JTF-T) 1) (setq prmt "Text to Right") (setq prmt "Text to Left"))
);if
(vl-load-com)
(if (not SS)
(progn
(prompt (strcat "\nSelect text object "))
(setq DK (grread nil 4 2))
(if (= (car DK) 3)
(setq SS (ssget "C" (cadr DK) (getcorner (cadr DK)) '((0 . "TEXT"))))
(if (= (cadr DK) 115)
(progn
(setq DCL_JTF (list "JTFtext : dialog {label = \"Justify in Region\"; : boxed_radio_row {"
" : radio_button { label = \"Left\"; key = \"Lft\";}"
" : spacer { width = 1.2; }"
" : radio_button { label = \"Center\"; key = \"Ctr\";}"
" : radio_button { label = \"Right\"; key = \"Rgt\";}}"
" ok_cancel;}"))
(setq TEMP_JTF (vl-filename-mktemp "CTK.DCL")
FILE_DCL (open TEMP_JTF "W"))
(foreach LL DCL_JTF (write-line LL FILE_DCL))
(close FILE_DCL)
(setq DCL_ID (load_dialog TEMP_JTF))
(new_dialog "JTFtext" DCL_ID)
(set_tile "Lft" (rtos (nth 0 JTF-T) 2 0))
(set_tile "Ctr" (rtos (nth 1 JTF-T) 2 0))
(set_tile "Rgt" (rtos (nth 2 JTF-T) 2 0))
(action_tile "accept" "(setq JTF-T (list(atof(get_tile \"Lft\"))(atof (get_tile \"Ctr\"))(atof (get_tile \"Rgt\"))))(done_dialog)")
(start_dialog)
(unload_dialog DCL_ID)
(vl-file-delete TEMP_JTF)
(setq SS (ssget '((0 . "TEXT"))))
);progn
(if (= (cadr DK) 32) (exit) (progn (prompt "\nWrong Key (!) Select text oject or press etting") (C:TC)))
);if
);if
);progn
);if
(if SS
(progn
(command "UCS" "W")
(setq OSMLAST (getvar "osmode"))
(setvar "OSMODE" 0)
(cond ((= (nth 1 JTF-T) 1)
(repeat (sslength SS)
(setq txt (ssname SS i) PTxt (GET_MIDTEXT txt) PTX (GET_CENTER_REGION PTxt) i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
);list_Ctr
((= (nth 0 JTF-T) 0)
(repeat (sslength SS)
(setq txt (ssname SS i) PTxt (GET_RIGHTTEXT txt) PTX (cadr (GET_LR_REGION PTxt)) i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
);list_rgt
((= (nth 2 JTF-T) 0)
(repeat (sslength SS)
(setq txt (ssname SS i) PTxt (GET_LEFTTEXT txt) PTX (car (GET_LR_REGION PTxt)) i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
);list_lft
);cond
(setvar "osmode" OSMLAST)
(command "UCS" "P")
);progn
);if
(prompt "Thaistreetz@gmail.com")
(command "undo" "end")
(princ)
);end TC
(defun GET_CENTER_REGION (PT / SSL PTC )
(setq SSL (entlast))
(if (= (DXF 0 SSL) "POLYLINE")
(while (/= "SEQEND" (DXF 0 (entnext SSL)))
(setq SSL (entnext SSL))
);while
);if
(vl-cmdf "-boundary" PT "")
(if (entnext SSL)
(progn
(command "region" "L" "")
(setq PTC (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (entlast)) 'Centroid))))
(command "erase" (entlast) "")
PTC
);progn
nil
);if
);END
(defun GET_LR_REGION (PT / SSL PTC )
(setq SSL (entlast))
(if (= (DXF 0 SSL) "POLYLINE")
(while (/= "SEQEND" (DXF 0 (entnext SSL)))
(setq SSL (entnext SSL))
);while
);if
(vl-cmdf "-boundary" PT "")
(if (entnext SSL)
(progn
(command "region" "L" "")
(setq PTC (ACET-GEOM-SS-EXTENTS-FAST (ssget "L")))
(command "erase" (entlast) "")
(list (list (car (car PTC)) (+ (cadr (car PTC)) (* 0.5 (abs (- (cadr (car PTC)) (cadr (cadr PTC)))))))
(list (car (cadr PTC)) (- (cadr (cadr PTC)) (* 0.5 (abs (- (cadr (car PTC)) (cadr (cadr PTC))))))))
);progn
nil
);if
);END
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(polar PT0 (+ (DXF 50 EN) (angle PT0 PTA)) (distance PT0 PTA))
);end
(defun GET_RIGHTTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(list(+(car PT0)(car (cadr TB))(abs(-(cadr(car TB))(cadr (cadr TB))))) (cadr(polar PT0 (+(DXF 50 EN)(angle PT0 PTA))(distance PT0 PTA))))
)
(defun GET_LEFTTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(list (- (car PT0) (abs (- (cadr (car TB)) (cadr (cadr TB))))) (cadr (polar PT0 (+ (DXF 50 EN) (angle PT0 PTA)) (distance PT0 PTA))))
)
(defun DXF (Id Obj)
(cdr (assoc Id (entget Obj)))
)
(defun GET_M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));end



Lisp này của sản phẩm của Mr.Thaistreetz
Hãy cám ơn tác giả nhé.
<<

Filename: 194296_tc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 194344
Tên lệnh: xp2t xp2c
( yêu cầu ) viết hộ mình líp này với !

Hề hề hề,
Bạn dùng thử lisp này coi đã ưng ý chưa nhé. Có hai lệnh là xp2t và xp2c để xuất điểm qua file *.txt hoặc file *.csv tùy bạn lựa chọn. các file xuất ra đều nằm chung thư mục chứa bản vẽ của bạn.
Nếu có gì không đồng ý thì hãy post lên để mình xem lại

Chúc bạn vui.

Filename: 194344_xp2t_xp2c.lsp
Tác giả: Thaistreetz
Bài viết gốc: 194408
Tên lệnh: wr
- Lệnh Bật/Tắt wipeout thay cho lệnh của cad
Bức xúc với việc fải lòng vòng để bật tắt wipeout bằng lệnh wipeout của cad và việc nó cứ tự động thêm 1 bước regen bản vẽ khi thực hiện thao tác bật hoặc tắt, bản vẽ nhẹ thì không sao chứ bản vẽ nặng thì cứ việc ngồi chờ dài cổ. Thế nên mình viết lại lệnh này cho dễ dùng hơn. Tặng các bạn dùng chơi.

;;; Copyright 2012 Thaistreetz from Cadviet.com
(defun c:wr (/ entmod-en...
>>
Bức xúc với việc fải lòng vòng để bật tắt wipeout bằng lệnh wipeout của cad và việc nó cứ tự động thêm 1 bước regen bản vẽ khi thực hiện thao tác bật hoặc tắt, bản vẽ nhẹ thì không sao chứ bản vẽ nặng thì cứ việc ngồi chờ dài cổ. Thế nên mình viết lại lệnh này cho dễ dùng hơn. Tặng các bạn dùng chơi.

;;; Copyright 2012 Thaistreetz from Cadviet.com
(defun c:wr (/ entmod-en ss->list en)
(defun entmod-en (code value en / elist) (entmod (subst (cons code value) (assoc code (setq elist (entget en '("*")))) elist)))
(defun ss->list (ss / i lst) (if ss (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst)))))
(if (not (setq en (dictsearch (namedobjdict) "ACAD_WIPEOUT_VARS")))
(prompt "<< Khong co doi tuong Wipeout nao trong ban ve >>")
(progn
(if (= (cdr (assoc 70 en)) 0)
(progn (entmod-en 70 1 (cdr (assoc -1 en))) (prompt ": << Bat Wipeout >>"))
(progn (entmod-en 70 0 (cdr (assoc -1 en))) (prompt ": << Tat Wipeout >>")))
(foreach en (ss->list (ssget "x" '((0 . "WIPEOUT,INSERT")))) (entupd en))))
(princ))


Bật và tắt đều dùng 1 lệnh duy nhất WR. không phải regen bản vẽ nên em nó nuột hơn hàng của Cad nhiều :D
<<

Filename: 194408_wr.lsp
Tác giả: Thaistreetz
Bài viết gốc: 194444
Tên lệnh: sx
Lisp chọn tập hợp đối tượng gần nhất được sinh ra bởi 1 lênh.
hà hà. chương trình của Detailing đạt 99% rồi. 1% còn lại hỏng khi có bước 4. cái này lúc trước bạn đã làm được nên mình đoán là có thể sửa được.

Vừa hay mình cũng viết xong bằng lisp. Lệnh này thực hiện công việc tưởng chừng đơn giản nhưng không ngờ viết lại phức tạp vậy. đây là lisp khiến mình vất vả nhất để nghĩ ra thuật toán kể từ khi viết lisp đến giờ....
>>
hà hà. chương trình của Detailing đạt 99% rồi. 1% còn lại hỏng khi có bước 4. cái này lúc trước bạn đã làm được nên mình đoán là có thể sửa được.

Vừa hay mình cũng viết xong bằng lisp. Lệnh này thực hiện công việc tưởng chừng đơn giản nhưng không ngờ viết lại phức tạp vậy. đây là lisp khiến mình vất vả nhất để nghĩ ra thuật toán kể từ khi viết lisp đến giờ. Mình phải kết hợp cả 2 ý tưởng của mình và của Detailing mới ra được kết quả này.

;;; Copyright 2012 Thaistreetz from Cadviet.com
(vl-load-com)
(defun C:SX (/ list->ss last-en lst)
(defun list->ss (lst / ss) (setq ss (ssadd)) (foreach s lst (ssadd s ss)))
(if *Reactor-CmdStart*
(or (vlr-added-p *Reactor-CmdStart*) (vlr-add *Reactor-CmdStart*)
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart)))))
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart)))))
(if *New-object*
(progn (setq last-en *New-object* lst (list *New-object*)) (while (setq last-en (entnext last-en)) (setq lst (cons last-en lst))) (sssetfirst nil (list->ss lst)))
(prompt "** Khong co doi tuong moi nao duoc tao **"))
(princ))
; Callback defun
(foreach x (cdar (vlr-reactors :vlr-editor-reactor)) (if (= (vlr-data x) "Editor Reactor: Command Start") (vlr-remove x)))
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart))))
(defun Callback-CmdStart (reactor lst)
(vlr-remove reactor)
(if *Reactor-Append*
(or (vlr-added-p *Reactor-Append*) (vlr-add *Reactor-Append*)
(setq *Reactor-Append* (vlr-acdb-reactor "Acdb Reactor: Select The new Objects" '((:vlr-objectAppended . Callback-objectadd)))))
(setq *Reactor-Append* (vlr-acdb-reactor "Acdb Reactor: Select The new Objects" '((:vlr-objectAppended . Callback-objectadd)))))
(if (eq (vlr-current-reaction-name) :vlr-commandwillstart) (setq *Cmdstart* T) (setq *Cmdstart* nil))) ;end
(defun Callback-objectadd (reactor object)
(vlr-remove reactor)
(setq *New-object* (cadr object))
(if *Cmdstart*
(if *Reactor-CmdStart*
(or (vlr-added-p *Reactor-CmdEnd*) (vlr-add *Reactor-CmdEnd*)
(setq *Reactor-CmdEnd* (vlr-editor-reactor "Editor Reactor: Command End" '((:vlr-commandEnded . Callback-CmdEnd) (:vlr-commandCancelled . Callback-CmdEnd) (:vlr-commandFailed . Callback-CmdEnd)))))
(setq *Reactor-CmdEnd* (vlr-editor-reactor "Editor Reactor: Command End" '((:vlr-commandEnded . Callback-CmdEnd) (:vlr-commandCancelled . Callback-CmdEnd) (:vlr-commandFailed . Callback-CmdEnd)))))
(if *Reactor-CmdStart*
(or (vlr-added-p *Reactor-CmdStart*) (vlr-add *Reactor-CmdStart*)
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart)))))
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart))))))) ;end
(defun Callback-CmdEnd (reactor lst)
(vlr-remove reactor)
(if *Reactor-CmdStart*
(or (vlr-added-p *Reactor-CmdStart*) (vlr-add *Reactor-CmdStart*)
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart)))))
(setq *Reactor-CmdStart* (vlr-editor-reactor "Editor Reactor: Command Start" '((:vlr-Lispwillstart . Callback-CmdStart)(:vlr-commandwillstart . Callback-CmdStart)))))) ;end

Lisp này sẽ chọn được các đối tượng mới tạo của lệnh cuối cùng bất cứ lúc nào người dùng muốn. không phải lo việc đánh dấu thủ công trước khi có nhu cầu chọn.
Các bác dùng thử xem nó có vướng phải vấn đề nào mà mình chưa ngờ tới hay không. Mình không có điều kiện để kiểm tra với các đối tượng tạo bằng lệnh của các ngôn ngữ lập trình khác nên chưa biết nó có chạy được không. còn với lệnh của cad hoặc lệnh lisp thì thấy có vẻ ổn rồi. Cảm ơn Detailing rất nhiều về đóng góp ý tưởng của bạn.
<<

Filename: 194444_sx.lsp

Trang 82/330

82