Jump to content
InfoFile
Tác giả: phamthanhbinh
Bài viết gốc: 227498
Tên lệnh: xotxt
lisp xoay text theo pline

File mẫu đây bác ơi.
 
http://www.fshare.vn/file/17SU9UVZCE/

Hề hề hề,của bạn đây:

Chúc bạn vui.
PS: bạn cũng có thể sử dụng cách của bác ketxu để lấy điểm đặt text cho nó đỡ phức tạp hơn. Vì mình chưa quan dùng...

>>

File mẫu đây bác ơi.
 
http://www.fshare.vn/file/17SU9UVZCE/

Hề hề hề,của bạn đây:

Chúc bạn vui.
PS: bạn cũng có thể sử dụng cách của bác ketxu để lấy điểm đặt text cho nó đỡ phức tạp hơn. Vì mình chưa quan dùng các hàm vla, vlax .... nên hơi ngại. Song trường hợp này thì dùng (vlax-get ....) của bác ketxu sẽ ngắn hơn nhiều.
Cụ thể: thay thế đoạn code
(if (or (/= (cdr (assoc 72 (setq etxt (entget txt)))) 0) (/= (cdr (assoc 73 etxt)) 0))
(vlax-curve-getclosestpointto obj (cdr (assoc 11 etxt)) T)
(vlax-curve-getclosestpointto obj (cdr (assoc 10 etxt)) T)
)
bằng đoạn code đơn giản:
(vlax-curve-getclosestpointto obj (vlax-get (vlax-ename->vla-object txt) 'InsertionPoint)
và thêm code xác định biến etxt
(setq etxt (entget txt))
là OK.
Hề hề hề


<<

Filename: 227498_xotxt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 227117
Tên lệnh: mtl
Lisp tạo viewport từ khung chọn bên model.

bạn cần gấp ko nhoc thử mò nãy giờ nhưng có 1 chỗ chưa làm đc ^^, bước
cuối phải thủ công tí xíu ^^ đó là điều chỉnh tỉ lệ lại cho khung view,
ví dụ tỉ lệ 1/100 nghĩa là khung view sẽ scale lên 10 lần nhưng khi bấm
vào khung view chỉ đc 9.7 mấy thui nhoc chưa tìm ra cách khắc phục,
nhưng chỉ cần chỉnh thủ công xíu đổi thành 10 thì sẽ vừa khít ngay, nhoc
cũng chỉ làm...

>>

bạn cần gấp ko nhoc thử mò nãy giờ nhưng có 1 chỗ chưa làm đc ^^, bước
cuối phải thủ công tí xíu ^^ đó là điều chỉnh tỉ lệ lại cho khung view,
ví dụ tỉ lệ 1/100 nghĩa là khung view sẽ scale lên 10 lần nhưng khi bấm
vào khung view chỉ đc 9.7 mấy thui nhoc chưa tìm ra cách khắc phục,
nhưng chỉ cần chỉnh thủ công xíu đổi thành 10 thì sẽ vừa khít ngay, nhoc
cũng chỉ làm đc tới đó thui, bạn thích thì dùng thử hen ^^, hoàn hảo
thì chờ anh KangKung biggrin.png

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL======== (defun C:mtl(/ taphop soluong size i index oldos p1)   (command "UNDO" "BE")   (setq oldos (getvar "osmode"))   (setvar "OSMODE" 1)   (setq taphop(ssget))    (setq Tyle (getreal (strcat "\n Ty le 1/ <1000>: ")))    (if (= Tyle nil) (setq Tyle 1000))     (setq soluong (sslength taphop))   (setq index 0)   (setq i 0)   (while (< index soluong) (setq i 1) (setq khung(ssname taphop index)) (setq lst(acet-geom-vertex-list khung)) (command "COPYCLIP" khung "") (command "LAYOUT" "N" "Layout1") (command "LAYOUT" "S" "Layout1") (command "ERASE" "ALL" "") (setq p1 (getpoint "\nchon diem dat:")) (command "PASTECLIP" p1) (command "SCALE" (entlast) "" p1 (/ 1000 tyle)) (command "MVIEW" "O" (entlast)) ;;;(command "MVIEW" "L" "on" (entlast) "") (command "MSPACE") (command "ZOOM" "e") (command "PSPACE") (command "ZOOM" "E") (setq index (+ index 1)) )   (command "UNDO" "END")   (setvar "OSMODE" oldos)   (princ)   )
<<

Filename: 227117_mtl.lsp
Tác giả: KangKung
Bài viết gốc: 227139
Tên lệnh: mtl
[Yêu cầu] Lisp tạo viewport từ khung chọn bên model.

Từ trước đến nay chưa thấy ai tạo viewport dị như vậy, tuy nhiên tôi vẫn sửa theo yêu cầu của bạn. Pline của bạn có kín hay không thì vẫn tạo được viewport. Lisp mới của bạn đây:

http://www.cadviet.com/upfiles/3/71162_mtl_rev4i_1.lsp

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O...
>>

Từ trước đến nay chưa thấy ai tạo viewport dị như vậy, tuy nhiên tôi vẫn sửa theo yêu cầu của bạn. Pline của bạn có kín hay không thì vẫn tạo được viewport. Lisp mới của bạn đây:

http://www.cadviet.com/upfiles/3/71162_mtl_rev4i_1.lsp

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL======== ;=========================REV4ii===================================== (defun C:mtl( / os lst khung X_min Y_min X_max Y_max X index taphop) (command "UNDO" "BE") (setq os(getvar "OSMODE")) (setvar "OSMODE" 0) (setq taphop(ssget )) (if (= Tyle nil) (setq Tyle1 1) (setq Tyle1 Tyle)) (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> "))) (if (= Tyle nil) (setq Tyle Tyle1)) (setq soluong (sslength taphop)) (setq index 0) (command "LAYOUT" "N" "Layout1") (command "LAYOUT" "S" "Layout1") (command "ERASE" "ALL" "") (command "MODEL") (setq X 0) (command "ZOOM" "E") (while (< index soluong) (setq khung(ssname taphop index)) (setq lst(acet-geom-vertex-list khung)) (setq X_min 1000000000 Y_min 1000000000 X_max -1000000000 Y_max -1000000000) (foreach a lst (if (< (car a) X_min) (setq X_min (car a))) (if (< (cadr a) Y_min) (setq Y_min (cadr a))) (if (> (car a) X_max) (setq X_max (car a))) (if (> (cadr a) Y_max) (setq Y_max (cadr a))) ) (command "LAYOUT" "S" "Layout1") (command "ZOOM" "W" (list X_min Y_min) (list X_max Y_max)) (command "PLINE") (foreach a lst (command a)) (command "C") (command "MOVE" (entlast) "" (list X_min Y_min) (list X 0)) (command "ZOOM" "W" (list 0 0) (list (+ X 100) 0)) (command "SCALE" (entlast) "" (list X 0) (/ 1 tyle)) (command "MVIEW" "O" (entlast)) (command "MSPACE") (command "ZOOM" (list X_min Y_min) (list X_max Y_max)) (command "PSPACE") (setq X(+ X 50 (/ (- X_max X_min) tyle))) (command "ZOOM" "W" (list 0 0) (list (+ X 100) 0)) (setq index (+ index 1)) ) (command "MODEL") (command "UNDO" "END") (setvar "OSMODE" os) (princ) )

 

 

@Nhoclangbat: sử dụng lệnh copyclip và pasteclip nên tất cả các viewport đều có hình dạng giống với viewport đầu tiên.

@girl: về yêu cầu chọn hình chữ nhật không song song trục X thì phải thêm lệnh để xoay khung HCN trong model về hướng nằm ngang. Yêu cầu này không khó, mình sẽ bổ sung sau.


<<

Filename: 227139_mtl.lsp
Tác giả: Tue_NV
Bài viết gốc: 59425
Tên lệnh: timsong
Viết Lisp theo yêu cầu

Cái này có lẽ không cần thiết. Vì dù có vẽ ở tỉ lệ nhỏ hay tỉ lệ lớn thì cái đường vẽ nối các trung điểm được dựng từ Pline1 và Pline 2. Pline1 và Pline 2 sdựng được => Đường vẽ nối các trung điểm sẽ dựng được cho dù vẽ ở tỉ lệ nhỏ hay tỉ lệ lớn. Bạn hiểu ý mình ở đây không?
Nhưng để đảm bảo chính xác hơn thì Tue_NV sẽ lấy số điểm chia là 2 trên 1 phân...
>>

Cái này có lẽ không cần thiết. Vì dù có vẽ ở tỉ lệ nhỏ hay tỉ lệ lớn thì cái đường vẽ nối các trung điểm được dựng từ Pline1 và Pline 2. Pline1 và Pline 2 sdựng được => Đường vẽ nối các trung điểm sẽ dựng được cho dù vẽ ở tỉ lệ nhỏ hay tỉ lệ lớn. Bạn hiểu ý mình ở đây không?
Nhưng để đảm bảo chính xác hơn thì Tue_NV sẽ lấy số điểm chia là 2 trên 1 phân đoạn (segment).
File Lisp này đã được Tue_NV chỉnh sửa lại chút ít. Chạy cùng với file này http://www.cadviet.com/upfiles/1_13.dwg

<<

Filename: 59425_timsong.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 227658
Tên lệnh: vc
[Nhờ giúp đỡ] lisp tọa độ vc

Em có down lisp xuất tọa độ vc trên diễn đàn nhưng em gặp 1 số vướng mắc mong các anh giúp em

hình file bản vẽ cuae em như thế này ạ

 

em muốn chỉnh file lisp để cho cái khung xuất tọa độ chiều ngang nó tăng lên vì như bản vẽ thì tọa độ nó bị chùm cả ra ngoài. và cái vị trí thứ tự 1,2,3,4 số...

>>

Em có down lisp xuất tọa độ vc trên diễn đàn nhưng em gặp 1 số vướng mắc mong các anh giúp em

hình file bản vẽ cuae em như thế này ạ

 

em muốn chỉnh file lisp để cho cái khung xuất tọa độ chiều ngang nó tăng lên vì như bản vẽ thì tọa độ nó bị chùm cả ra ngoài. và cái vị trí thứ tự 1,2,3,4 số 4,3 bị dính vào hình em muốn nó dịch sang bên trái với khoảng cách như số 1,2 ạ. Mong các anh giúp em. Em cảm ơn trước ạ

đây là file bản vẽ

http://www.mediafire.com/?xih9xd2os48gixg

còn đây là file lisp 

http://www.mediafire.com/?rleu61gkzhse69s

Hề hề hề,

Yêu cầu của bạn không dễ làm bởi chỉ có giời mới biết theo bạn thế nào là đẹp. Bạn nên tìm hiểu về lisp để có thể tự mình chỉnh sửa lisp sẵn có theo yêu cầu của bạn. Tất cả các lisp có sẵn đều đã được viết theo những yêu cầu cụ thể của mỗi người sử dụng và nó chỉ có tính chất tham khảo với người sử dụng khác. Chín người thì mười ý kiến khác nhau nên việc có một lisp dùng cho tất cả mọi người là rất khó bạn ạ. Mọi người có thể chỉnh sữa cho bạn lần này với cái hình cụ thể bạn đã post, còn những lần khác thì sao, khi hình bạn post không phải là một hình chữ nhật và không chỉ có 4 đỉnh. Khi đó cái chỉnh sửa lần này sẽ trở thành vô nghĩa và bạn sẽ lại ối giời ơi nữa ư???

Với yêu cầu thứ nhất, vấn đề của bạn là do số lượng các chữ số dùng ghi tọa độ lớn quá nên độ rộng khung ấn định của líp trở nên chật chội. Bạn chỉ cần chỉnh sửa kích thước của khung là Ok. Kích thước rộng ấn định của khung theo lisp là 8 lần chiều cao text trong khi số lượng chữ số bạn dùng tới 10 kí tự. Bạn chỉ cần nâng giá trị này thành 10 lần chiều cao text là sẽ ngon ngay. Tuy nhiên như vậy nếu với những bản vẽ khác, số lượng chữ số này thay đổi thì cái khung của bạn sẽ lại trở nên quá chật hay quá rộng ngay và lại mất đẹp liền. Mình sửa lần này cho bạn và bạn hãy so sánh với lisp  nguyên gốc để thấy chỗ khác nhau. Từ đó suy ra cách sửa cho những lần sau.

Với yêu cầu 2: Việc đánh số các đỉnh này chỉ có tác dụng giúp bạn nhận biết vị trí các đỉnh tường ứng với bảng tọa độ. Vị trí ghi các con số đánh dấu này thực khó để nói thế nào là đẹp, là đúng vì nó phụ thuộc vào quan điểm của cá nhân. Do không thể xác định trước vị trí ghi nào là đẹp trên bản vẽ nên người viết lisp cứ làm cả loạt theo một quy tắc chung là lệch phải so với vị trí cần đánh dấu một khoảng bằng chiều cao text. nếu bạn thấy chưa vừa mắt có thể tự move nó đi tới vị trí mà bạn cho là OK. Đơn giản vậy thôi. Còn nếu bắt lisp phải tự chọn chỗ đẹp cho cái vị trí đánh số này thì quả thực là rất khó bởi việc xác định vị trí đánh số đầu tiên hoàn toàn là ngẫu nhiên không dễ để xác định đâu. Với trường hợp cụ thể này của bạn, mình có thể sửa nhưng không đảm bảo được là nó sẽ chạy đúng với các hình khác, nhất là khi số đỉnh tăng lên hay hình chữ nhật này bị xoay đi một góc.

Bạn hãy so sánh lisp đã sửa này với lisp gốc để biết được chỗ mình đã sửa và học lấy cách sửa để có thể tự sửa theo những yêu cầu khác nhau của bạn.

Nó đây:

 
Chúc bạn vui.

<<

Filename: 227658_vc.lsp
Tác giả: duy782006
Bài viết gốc: 9655
Tên lệnh: %2F
Lệnh scale


LỆNH LÀ /


Filename: 9655_%2F.lsp
Tác giả: Chiron
Bài viết gốc: 227695
Tên lệnh: tinh
[nhờ giúp đỡ] lisp tính các phép tính toán cơ bản với text

Có phải bạn muốn thế này:

(defun c:tinh (/ ss ent sobitru sotru sobichia sochia ssle1 kqua)
(vl-load-com)

(initget "+ - * /")
(setq ptinh1 (getkword "Chon phep tinh <+ - * />: "))

(if ptinh1
(setq ptinh ptinh1)
)

(cond ((= ptinh "+")
;;; cong
(prompt "\nChon text de cong:")
(setq ss (ssget '((0 . "TEXT")))
kqua 0
)
(while (and ss (> (sslength ss) 0))
(setq kqua
(+ kqua
(atof (cdr (assoc 1...

>>

Có phải bạn muốn thế này:

(defun c:tinh (/ ss ent sobitru sotru sobichia sochia ssle1 kqua)
(vl-load-com)

(initget "+ - * /")
(setq ptinh1 (getkword "Chon phep tinh <+ - * />: "))

(if ptinh1
(setq ptinh ptinh1)
)

(cond ((= ptinh "+")
;;; cong
(prompt "\nChon text de cong:")
(setq ss (ssget '((0 . "TEXT")))
kqua 0
)
(while (and ss (> (sslength ss) 0))
(setq kqua
(+ kqua
(atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))
)
)
(ssdel ent ss)
)
(princ kqua)
)

((= ptinh "*")
;;;nhan
(prompt "\nChon text de nhan:")
(setq ss (ssget '((0 . "TEXT")))
kqua 1
)
(while (and ss (> (sslength ss) 0))
(setq kqua
(* kqua
(atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))
)
)
(ssdel ent ss)
)
(princ kqua)
)

((= ptinh "-")
;;;tru
(setq sobitru (car (entsel "\nChon so bi tru:"))
sotru (car (entsel "\nChon so tru:\n"))
kqua (- (atof (cdr (assoc 1 (entget sobitru))))
(atof (cdr (assoc 1 (entget sotru))))
)
)
(princ kqua)
)

((= ptinh "/")
;;;chia
(setq sobichia (car (entsel "\nChon so bi chia:"))
sochia (car (entsel "\nChon so chia:\n"))
kqua (/ (atof (cdr (assoc 1 (entget sobichia))))
(atof (cdr (assoc 1 (entget sochia))))
)
)
(princ kqua)
)
)
(if (not ssle)
(setq ssle 0)
)
(setq obj (vlax-ename->vla-object
(car (entsel "\nChon text de ghi ket qua:"))
)
ssle1 (getint (strcat "\nSo so le <" (itoa ssle) ">: "))
)
(if ssle1
(setq ssle ssle1)
)
(vla-put-TextString obj (rtos kqua 2 ssle))

(princ)
)

Không biết tác giả có ý đồ gì lại dùng tất cả biến toàn cục?!


<<

Filename: 227695_tinh.lsp
Tác giả: thaoanthony
Bài viết gốc: 227283
Tên lệnh: tff
Xuất và nhập tọa độ bằng lisp
E sưu tầm được file lisp như sau để lấy tọa độ XYZ của các điểm thay cho lệnh ID. Nhưng sau khi e xuất ra file txt, thì chỉ lấy được 3 số thập phân, trong khi e muốn lấy 4 số, và không làm tròn. Mong ae có thể sửa code trong lisp này dùm e.
Và cho e hỏi luôn là sau khi mình xuất ra file txt rồi, thì e muốn xuất ngược bảng tọa độ đó vào Cad có được không???Mong ae chỉ dạy.
Cảm ơn ae rất...
>>
E sưu tầm được file lisp như sau để lấy tọa độ XYZ của các điểm thay cho lệnh ID. Nhưng sau khi e xuất ra file txt, thì chỉ lấy được 3 số thập phân, trong khi e muốn lấy 4 số, và không làm tròn. Mong ae có thể sửa code trong lisp này dùm e.
Và cho e hỏi luôn là sau khi mình xuất ra file txt rồi, thì e muốn xuất ngược bảng tọa độ đó vào Cad có được không???Mong ae chỉ dạy.
Cảm ơn ae rất nhiều và nội dung file lisp e có như sau : 
 
 

;; free lisp from cadviet.com;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/5852-lisp-xuat-toa-do/
(defun c:tff ( / tmp dlst p1 file opw msg id)
(setq tmp t)
(setq dlst (list(strcat "X" "\t" "Y" "\t" "Z")))
(setq id 0)
(setq file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt"))
(while tmp (progn (setq id (1+ id))
(setq msg (strcat "\nChon diem thu " (rtos id 2 0)":"))
(setq p1 (getpoint msg))
(if p1 (progn (setq dlst (append (list (strcat (rtos (car p1) 2 3)
"\t" (rtos (cadr p1) 2 3)
"\t" (rtos (caddr p1) 2 3)
)
)
dlst )
)
(setq tmp t)
)
(setq tmp nil)
)
)
)
(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt" opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw));end defun----------------

<<

Filename: 227283_tff.lsp
Tác giả: avi612
Bài viết gốc: 227036
Tên lệnh: kt dlo
Lisp tạo viewport từ khung chọn bên model.

cây nhà lá vườn!!!!
Cái này viết lâu rồi chỉ để dành sài...lâu ngày lên CADviet thấy bà con bàn tới nên post tham khảo.
 
  ;>>> SUB FUNTION <<< ;======================================================================================================================================================================= ; >>> HAM SAP XEP CAC DOI TUONG <<< (defun Soft-Value (ss / ss_t kq luu j tam) (setq ss_t (ssadd))...

>>

cây nhà lá vườn!!!!
Cái này viết lâu rồi chỉ để dành sài...lâu ngày lên CADviet thấy bà con bàn tới nên post tham khảo.
 
  ;>>> SUB FUNTION <<< ;======================================================================================================================================================================= ; >>> HAM SAP XEP CAC DOI TUONG <<< (defun Soft-Value (ss / ss_t kq luu j tam) (setq ss_t (ssadd)) (repeat (sslength ss) (setq tam (ssname ss 0)) (setq j 1) (repeat (- (sslength ss) 1) (if (> (atof (cdr (assoc 1 (entget tam)))) (atof (cdr (assoc 1 (entget (ssname ss j)))))) (setq tam (ssname ss j)) ) (setq j (+ j 1)) ) (setq ss (ssdel tam ss)) (setq ss_t (ssadd tam ss_t)) ) (setq ss ss_t) ) ;======================================================================================================================================================================= ; >>> HAM XAC DINH KHUNG BAN VE <<< (defun c:kt (/ path) (setq path (getvar "dwgprefix")) (setq Drawings-Frame (getfiled ">> Select Frame Objects" path "dwg" 0)) (princ) (princ) ) ;======================================================================================================================================================================= ; >>> HAM CHEN KHUNG TEN VAO BAN VE BANG XREF <<< (defun Insert-New-Frame (pt / th thl i thi list_thi loai default old new tmode) (setq tmode (getvar "TILEMODE")) (If (= tmode 1) (Setvar "TILEMODE" 0)) (setvar "INSUNITS" 4) (command "xref" "a" Drawings-Frame pt 1 1 0) (command ".zoom" "e") ) ;======================================================================================================================================================================= ; >>> HAM THAY DOI GIA TRI Customscale CUA HANG LOAT Viewport <<< (defun Custom-View (Obj New-customscale / SSlen i Ename) (vl-load-com) ;(Prompt "\n>> Nhap gia tri ti le: ") ;(setq New-customscale (getreal "\n>> Nhap gia tri ti le: ")) ;(setq Obj (ssget ":N" '((0 . "VIEWPORT")))) (setq SSlen (sslength Obj)) (setq i 0) (while (< i SSlen) (setq Ename (vlax-ename->vla-object (ssname Obj i))) (vla-put-customscale Ename New-customscale) (setq i (1+ i)) ) ) ;======================================================================================================================================================================= (defun VT-AddLayer(Lname Ltype Color Desc / *kpblc-activedoc* layer) (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))) (setq layer (vla-add (vla-get-layers *kpblc-activedoc*) Lname)) (vla-put-Linetype layer Ltype) (vla-put-color layer Color) (vla-put-Description layer Desc) ;(vla-put-Lineweight layer Lweight) (princ) (princ) ) ;======================================================================================================================================================================= ;>>> MAIN FUNTION <<< (defun c:dlo (/ cl #Tilemode ss Insert-point X-Point Y-Point i OSluu entkhung entp Insert-point P1-frame P2-frame vieww tle new-scale) (command "undo" "be") (setq cl (getvar "CLAYER")) (setvar "cmdecho" 0) (setvar "blipmode" 0) (setq #Tilemode (getvar "TILEMODE")) (setvar "TILEMODE" 1) ;(Prompt "\nCh\U+1ECDn b\U+1EA3n v\U+1EBD khung tên") ;(setq path (getvar "dwgprefix")) ;(setq Drawings-Frame (getfiled "Ch\U+1ECDn b\U+1EA3n v\U+1EBD khung tên" path "dwg" 0)) (if (= Scale-Draw nil) (setq Scale-Draw2 5) (setq Scale-Draw2 Scale-Draw)) (setq Scale-Draw (getreal (strcat "\n - Nh\U+1EADp t\U+1EF7 l\U+1EC7 b\U+1EA3n v\U+1EBD: 1/<" (rtos Scale-Draw2 2 1) ">"))) (if (= Scale-Draw nil) (setq Scale-Draw Scale-Draw2)) (setq ss (ssget (list (cons 0 "TEXT") (cons 8 "sttchonkhung")))) (setq ss (Soft-Value ss)) (setvar "TILEMODE" 0) (setq Insert-point (getpoint "\n - Ch\U+1ECDn \U+0111i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u r\U+1EA3i: ")) (setq X-Point (car Insert-point)) (setq Y-Point (cadr Insert-point)) (setq Num-Frame (sslength ss)) (setq i 0) (if (= Drawings-Frame nil) (c:kt)) (setq OSluu (getvar "OSMODE")) (setvar "OSMODE" 0) (while (< i Num-Frame) (setq entkhung (ssname ss i)) (setq entp (cdr (assoc 11 (setq entam (entget entkhung)))));Diem chen cua Text (setq Insert-point (list (+ X-Point (* i 420)) Y-Point)) ;===== Chen khung ten bang lenh Xref ===== (Insert-New-Frame Insert-point) ;===== Ve khung viewport ===== (setq P1-frame (list (+ (car Insert-point) 27) (+ (cadr Insert-point) 41))) (setq P2-frame (list (+ (car Insert-point) 407) (+ (cadr Insert-point) 286))) (if (= (tblsearch "layer" "Defpoints") nil) ;(command ".-layer" "M" "Defpoints" "C" 250 "" "") (VT-ADDLAYER "Defpoints" "Continuous" 250 "Hide Frame") ) (setvar "CLAYER" "Defpoints") (command ".mview" P1-frame P2-frame) (setq vieww (entlast)) (command ".mspace") (command ".zoom" "c" entp 245);ZOOM 1:1 (setq tle (/ 1 Scale-Draw)) (setq new-scale (strcat (rtos tle 2 5) "XP"));ZOOM CUSTOME (command ".zoom" new-scale) (command ".pspace") (command ".zoom" "o" vieww "") (setq i (1+ i)) ) (setvar "CLAYER" cl) (setvar "OSMODE" OSluu) ;(alert "Lisp chay xong") (command ".zoom" "e") (command ".undo" "e") (Prompt (strcat "Chay xong " (rtos Num-Frame 2 0) " khung")) (princ) )
 
 
 Lisp này cũng có cái bất tiện là phải tạo 1 layer có tên là "sttchonkhung" để tạo trước các khung hình chữ nhật bên model sau đó mới tiến hành lệnh DLO.
Đang làm cái video cho bà con...khi nào xong sẽ post lên.
@Video hướng dẫn: http://www.youtube.com/watch?v=2A0JVh1GeYc
---------------------------------
Lâu ngày không ghé.. giờ forum nâng cấp khác quá nên post lisp ko quen...ai sửa lại giúp nhá.


<<

Filename: 227036_kt_dlo.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 227790
Tên lệnh: ha
Giúp mình lisp Dim chia đoạn thẳng

Cái này dựa trên lisp của anh Gia_Bach (thanks!), sửa lại vài tí cho bạn dùng.

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd ss1 x)

 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
             old (cdddr old))) new)
  (setq i -1)
  (while (setq e...
>>

Cái này dựa trên lisp của anh Gia_Bach (thanks!), sửa lại vài tí cho bạn dùng.

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd ss1 x)

 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
             old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
    (setq lst_pt (append (list->3pair pts) lst_pt))))
  (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
 (vl-load-com)
 (setq cd (getreal "\nChieu dai moi doan chia: "))
 (if (and (setq pt1 (getpoint "\nDiem dau :"))
               (setq pt2 (getpoint pt1 "\nDiem cuoi :"))
               (setq pt3 (getpoint "\nDiem dat duong dim :")))
  (progn
   (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
   (repeat (1+ n)
    (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pt3a (polar px (+ (angle px pt3) pi) 1))
    (entmakex (list (cons 0 "LINE") (cons 10 pt3) (cons 11 pt3a)))
    (setq ss1 (ssadd (entlast) ss1))
    (setq x (1+ x)))
   (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
    (progn
     (entmakex (list (cons 0 "LINE") (cons 10 pt2) (cons 11 (polar pt2 (+ (angle pt2 pt3) pi) 1))))
     (setq ss1 (ssadd (entlast) ss1))))
   (setq ss (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
             line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
   (setq pts (Get_pts_ss_inter_obj ss line))
   (if (> (vl-list-length pts) 1)
    (progn
     (setq sta (car pts) i 1)
     (repeat (- (vl-list-length pts)1)
      (setq end (nth i pts) i (1+ i))
      (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
      (setq sta end))))
   (vla-delete line)))
   (command "erase" ss1 "")
 (princ))

<<

Filename: 227790_ha.lsp
Tác giả: nataca
Bài viết gốc: 49842
Tên lệnh: ns
Thuật toán nội suy cao độ tự nhiên trong Nova

Nói thật mình không thích gửi riêng qua email lắm. Mình post lại lisp của bác Nguyen Hoanh lên đây cho mọi người. (@ bác Nguyen Hoanh ơi không hiểu sao chức năng tìm kiếm trên diễn đàn không hiệu quả lắm. Có cái biết chắc chắn có mà tim mãi không ra)

Filename: 49842_ns.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 227851
Tên lệnh: dimatinter ha
Giúp mình lisp Dim chia đoạn thẳng

Quên mất trường hợp có các đường cắt ngang. Sửa lại cho bạn đây.

;Chia Dim doan thang (03/03/2013).

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd x)
 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss...
>>

Quên mất trường hợp có các đường cắt ngang. Sửa lại cho bạn đây.

;Chia Dim doan thang (03/03/2013).

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd x)
 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
    (setq lst_pt (append (list->3pair pts) lst_pt))))
  (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
 (vl-load-com)
 (setq cd (getreal "\nChieu dai moi doan chia: "))
 (if
  (and
   (setq pt1 (getpoint "\nDiem dau: "))
   (setq pt2 (getpoint pt1 "\nDiem cuoi: "))
   (setq pt3 (getpoint "\nDiem dat duong dim: ")))
  (progn
   (setq ssc (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
   (repeat (1+ n)
    (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pxt (polar px (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar px (- (angle pt1 pt2) (* 0.5 pi)) 100))
    (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
    (setq ss1 (ssadd (entlast) ss1))
    (setq x (1+ x)))
   (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
    (progn
     (setq pxt (polar pt2 (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar pt2 (- (angle pt1 pt2) (* 0.5 pi)) 100))
     (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
     (setq ss1 (ssadd (entlast) ss1))))
   (setq ssm (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (defun TRUSS (ssm ssc / i) (repeat (setq i (sslength ssc)) (ssdel (ssname ssc (setq i (1- i))) ssm)))
   (setq ss (TRUSS ssm ssc))
   (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
         line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
   (setq pts (Get_pts_ss_inter_obj ss line))
   (if (> (vl-list-length pts) 1)
    (progn
     (setq sta (car pts) i 1)
     (repeat (- (vl-list-length pts)1)
      (setq end (nth i pts) i (1+ i))
      (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
      (setq sta end))))
   (vla-delete line)))
 (command "erase" ss1 "")
 (princ))

<<

Filename: 227851_dimatinter_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 227851
Tên lệnh: ha
Giúp mình lisp Dim chia đoạn thẳng

Quên mất trường hợp có các đường cắt ngang. Sửa lại cho bạn đây.

;Chia Dim doan thang (03/03/2013).

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd x)
 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss...
>>

Quên mất trường hợp có các đường cắt ngang. Sửa lại cho bạn đây.

;Chia Dim doan thang (03/03/2013).

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd x)
 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
    (setq lst_pt (append (list->3pair pts) lst_pt))))
  (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
 (vl-load-com)
 (setq cd (getreal "\nChieu dai moi doan chia: "))
 (if
  (and
   (setq pt1 (getpoint "\nDiem dau: "))
   (setq pt2 (getpoint pt1 "\nDiem cuoi: "))
   (setq pt3 (getpoint "\nDiem dat duong dim: ")))
  (progn
   (setq ssc (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
   (repeat (1+ n)
    (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pxt (polar px (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar px (- (angle pt1 pt2) (* 0.5 pi)) 100))
    (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
    (setq ss1 (ssadd (entlast) ss1))
    (setq x (1+ x)))
   (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
    (progn
     (setq pxt (polar pt2 (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar pt2 (- (angle pt1 pt2) (* 0.5 pi)) 100))
     (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
     (setq ss1 (ssadd (entlast) ss1))))
   (setq ssm (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (defun TRUSS (ssm ssc / i) (repeat (setq i (sslength ssc)) (ssdel (ssname ssc (setq i (1- i))) ssm)))
   (setq ss (TRUSS ssm ssc))
   (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
         line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
   (setq pts (Get_pts_ss_inter_obj ss line))
   (if (> (vl-list-length pts) 1)
    (progn
     (setq sta (car pts) i 1)
     (repeat (- (vl-list-length pts)1)
      (setq end (nth i pts) i (1+ i))
      (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
      (setq sta end))))
   (vla-delete line)))
 (command "erase" ss1 "")
 (princ))

<<

Filename: 227851_ha.lsp
Tác giả: admin
Bài viết gốc: 912
Tên lệnh: caltxt
Lisp tính toán công thức toán học của đối tượng text
Tại sao bạn không sử dụng bảng (table) trong AutoCAD? đối tượng này giống hệt excel. Chi tiết, xin xem thêm bài viết của bemove tại: http://www.cadviet.com/forum/index.php?sho...0&#entry869

Nếu đó vẫn chưa phải là câu trả lời thì không rõ đối tượng của bạn là gì, Text hay block attribute? Nếu bạn thống kê không sử dụng...
>>
Tại sao bạn không sử dụng bảng (table) trong AutoCAD? đối tượng này giống hệt excel. Chi tiết, xin xem thêm bài viết của bemove tại: http://www.cadviet.com/forum/index.php?sho...0&#entry869

Nếu đó vẫn chưa phải là câu trả lời thì không rõ đối tượng của bạn là gì, Text hay block attribute? Nếu bạn thống kê không sử dụng lisp, bạn có thể dùng chức năng table rất dễ dàng (như đã nói ở trên). Còn nếu bạn thống kê có sử dụng lisp, tại sao bạn không chèn công thức trong mã lệnh lisp luôn (các chương trình lisp thống kê thường tích hợp vào luôn)/

Nếu các cách trên vẫn chưa phải là mục đích của bạn, bạn hãy nêu rõ hơn nữa về yêu cầu của bạn.

----------------------------------------------
Nhân đây, có 1 lisp có thể tính toán hiệu quả giá trị của text trong AutoCAD xin tặng các thành viên cadviet:


lisp này với lệnh caltxt có tác dụng thay thế một đối tượng text chứa công thức bằng giá trị của công thức đó.
VD: text có giá trị: (1+2-3+4*5)/6 sẽ được thay bằng 3.3333
<<

Filename: 912_caltxt.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 227946
Tên lệnh: ha
Xin lisp đưa dạng text (content) thành cao độ (dạng số)

Code nhanh cho bạn đây.

(defun C:HA( / ss elist ass)

 (if (setq ss (ssget '((0 . "*TEXT"))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq elist (entget ent) ass (assoc 10 elist))
   (entmod (subst (cons 10 (list (cadr ass) (caddr ass) (atof (cdr (assoc 1 elist))))) ass elist))))
 (princ))

Filename: 227946_ha.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 228014
Tên lệnh: xktl
Lisp xoá khung tên bên layout!

http://www.cadviet.com/upfiles/3/111440_xoa_khung_ten.dwg

Hề hề hề,

Thử dùng cái ni xem sao nhé.

Tại sao bạn không làm khung ten thành một block chứa thuộc tính cho tiện sử dụng mà lại làm khung tên rời rạc như vậy. 

Cái lisp này chỉ...

>>

http://www.cadviet.com/upfiles/3/111440_xoa_khung_ten.dwg

Hề hề hề,

Thử dùng cái ni xem sao nhé.

Tại sao bạn không làm khung ten thành một block chứa thuộc tính cho tiện sử dụng mà lại làm khung tên rời rạc như vậy. 

Cái lisp này chỉ xóa được các khung tên có cùng kích thước và vị trí như bản vẽ bạn đã post, nếu sử dụng khung tên khác thì việc xóa sẽ không đảm bảo sạch đâu nhé, thậm chí nó có thể xóa cả những thứ bạn không muốn xóa đó.

Nếu có gì chưa ưng ý thì cứ mạnh dạn mà tố nghen.

<<

Filename: 228014_xktl.lsp
Tác giả: tvgtyb08
Bài viết gốc: 136577
Tên lệnh: menutvgtyb08%3Cbr%3E
Mình muốn chuyển từ *.lsp sang *.vlxthi làm the nao?
Các anh ơi chuyển giúp em lisp này sang VLX với, em chuyển nó toàn báo lỗi và ra định dạng *.PRV

Filename: 136577_menutvgtyb08%3Cbr%3E.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 228074
Tên lệnh: gcddm
Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

Chào mọi người, mình có bình đồ dạng số hóa (của cục lưu trữ bản đồ), trong đó chủ yếu là các đường đồng mức, nhưng hay bị đứt khúc (ko còn là dạng pline). Mình có thể định nghĩa lại các đường đồng mức này, chắc phải gán cao độ cho từng đường, tuy nhiên rất mất thời gian, không hiểu còn cách...

>>

Chào mọi người, mình có bình đồ dạng số hóa (của cục lưu trữ bản đồ), trong đó chủ yếu là các đường đồng mức, nhưng hay bị đứt khúc (ko còn là dạng pline). Mình có thể định nghĩa lại các đường đồng mức này, chắc phải gán cao độ cho từng đường, tuy nhiên rất mất thời gian, không hiểu còn cách nào nhanh hơn không. Mong mọi người chỉ giúp. Hơn nữa mình cũng muốn sau đó đưa được bình đồ này về dạng các điểm có cao độ, mong mọi người cho phương hướng hoặc cho mình các lisp, phần mềm liên quan. Cám ơn cả nhà.

 

http://www.mediafire.com/?1sp0gselxtwnkxt

Hề hề hề,

Mình không phải dân chuyên ngành của bạn. Sau khi đọc yêu cầu của bạn và xem bản vẽ bạn gửi, minh viết cái lisp sau giúp bạn có thể ghi được cao độ của các đường đồng mức dựa vào cách làm như sau:

1/- Mở bản vẽ zoom gần tới một vị trí point chuẩn có ghi sẵn cao độ của điểm đó. Tỷ dụ bạn chọn điểm có cao độ là 392

2/- Vẽ một lwpolyline sao cho nó cắt mỗi đường đồng mức chỉ tại một điểm theo một chiều.gọi là đường dẫn

3/- load lisp

4/- Gõ lệnh cddm và làm theo các yêu cầu của lisp;

  Khi líp yêu cầu chọn đường dẫn thì chọn polyline vừa vẽ

  Khi lisp yêu cầu nhập cao độ bắt đầu thì nhập giá trị chẵn bước của đường đồng mức gần với điểm đã ghi cao độ trước (trong trường hợp cụ thể bản vẽ của bạn gửi thì nhập 380 tường ứng với cao độ điểm là 392)

 Khi líp yêu cầu nhập độ chênh cao giữa các đường đồng mức thì tùy theo chiều vẽ polyline mà nhấp giá trị dương hay âm của độ chênh cao này (trong trường hợp bản vẽ bạn gửi thì giá trị này là + hoặc - 20.

Sau đó nhấn enter và chờ líp hoàn thành công việc của nó.

5/- Check lại xem lisp ghi đúng chưa, nếu thấy chưa đúng thì undo để xóa toàn bộ những gì líp đã làm, không ảnh hưởng tới bản vẽ của bạn.

 

Lưu ý rằng trong bản vẽ bạn gửi, các đường đồng mức nằm trên nhiều layẻ khác nhau mà mình chỉ mới phát hiện được có 3 layẻ là 1,2 và 5. Khi thấy lisp bỏ sót các đường đồng mức chưa được ghi cao độ thì có thể là do đường đồng mức đó nắm khác layẻ với các layẻ kể trên và bạn phải bổ sung layẻ này vào trong bộ chọn đối tượng của lisp.

Hy vọng bạn có thể dùng được lisp này để thuận lợi cho công việc của bạn. Nếu quá trình dùng có vấn đề gì chưa rõ cứ post lên mình sẽ tìm hiểu và giải thích.

Chúc bạn vui

 


<<

Filename: 228074_gcddm.lsp
Tác giả: VUVUZELA
Bài viết gốc: 104924
Tên lệnh: batter
viết giúp em cái lisp rải mái taluy
Đây nè, cho các bác bộ mã nguồn luôn
Về nghiên cứu thêm nhé


Filename: 104924_batter.lsp
Tác giả: LoveLisp
Bài viết gốc: 227266
Tên lệnh: mh
[GẤP] Lỗi Hatch Solid bị dư cấc đường line khó chịu.

Mình không có cách nào để xử lý cả, có lẽ do AutoCAD chứ không phải do bản vẽ của bạn. Tạm thời, bạn có thể chia nhỏ phân vùng cần hatch, sau đó sử dụng lisp sau để nối chúng lại với nhau.

(defun c:mh (/ ss entht sl i dt dtht) (princ "\nMerge Hatch - free lisp from CADViet.com") (setq ss (ssget '((0 . "HATCH"))) sl (if ss (sslength ss) 0 ) i 0 l 0 ) (repeat sl (setq entht (ssname ss i) dtht (getbdata entht) dt (append dt dtht) l (+ l (cdr (assoc 91 (entget entht)))) i (1+ i) ) ) (setq ent (ssname ss 0) ss (ssdel ent ss) tt (entget ent) duoi (member (assoc 75 tt) tt) dau (reverse (member (assoc 91 tt) (reverse tt))) tt (append dau dt duoi) tt (subst (cons 91 l) (assoc 91 tt) tt) ) (entmod tt) (command ".erase" ss "") (princ) ) (defun getbdata (ent) (setq tt (entget ent) tt (cdr (member (assoc 75 tt) (reverse tt))) tt (cdr (member (assoc 91 tt) (reverse tt))) ) ) (princ "\nMerge Hatch (c) CADViet.com is loaded, please type MH to start!") (princ)
<<

Filename: 227266_mh.lsp

Trang 120/330

120