Jump to content
InfoFile
Tác giả: gia_bach
Bài viết gốc: 177891
Tên lệnh: at2t
Lisp Ghép Text Cần Giúp Đỡ


Tiếc nhỉ, tui chả biết Speedcad là cái gì ?
Phải đơn giản như thế này ko?

(defun c:at2t (/ data edata ent i sel ss str);All Text to Text
(defun dxf (tag obj) (cdr (assoc tag obj)))
(setq ss (ssadd))
(while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (cdr (assoc 0 (entget ent))) "TEXT")
(ssadd ent ss)) )
(if (> (sslength ss) 0)
>>

Tiếc nhỉ, tui chả biết Speedcad là cái gì ?
Phải đơn giản như thế này ko?

(defun c:at2t (/ data edata ent i sel ss str);All Text to Text
(defun dxf (tag obj) (cdr (assoc tag obj)))
(setq ss (ssadd))
(while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (cdr (assoc 0 (entget ent))) "TEXT")
(ssadd ent ss)) )
(if (> (sslength ss) 0)
(progn
(setq i 0
data (entget (ssname ss 0))
str (dxf 1 data))
(while (setq ent (ssname ss (setq i (1+ i))))
(setq edata (entget ent)
str (strcat str " " (dxf 1 edata)) )
(entdel ent) )
(entmod (subst (cons 1 str) (assoc 1 data) data)) )
(princ "\nKhong chon duoc Text !"))
(princ))

<<

Filename: 177891_at2t.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 177961
Tên lệnh: cc
nhờ hoàn thiện lisp in khoảng cách
Đây bạn!

Filename: 177961_cc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 177853
Tên lệnh: oca
các anh em prô ơi viết giùm em cái list

Hề hề hề,
Bạn thử thay cái lisp này vào cái lisp ocA ở trên xem sao nhé. Mình đã bổ sung theo ý bạn nhưng chưa test, bạn cứ chạy thử xem, có gì thì post lên để mình chỉnh lại.

Hy vọng nó thỏa mãn yêu cầu của bạn.

Hề hề hề

Filename: 177853_oca.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 177965
Tên lệnh: ha
tính toán đặc trưng hình học

Không biết ý bạn có phải thế này không?

Filename: 177965_ha.lsp
Tác giả: ketxu
Bài viết gốc: 178221
Tên lệnh: at2t
Ghép Text


- Phiên bản chọn 1 loạt rồi nối


Filename: 178221_at2t.lsp
Tác giả: hoa35ktxd
Bài viết gốc: 104766
Tên lệnh: pllev pl2lev
GHI CAO ĐỘ TUYẾN CỐNG
Bạn thử cái này xem nhé

Filename: 104766_pllev_pl2lev.lsp
Tác giả: ketxu
Bài viết gốc: 178321
Tên lệnh: hh
Hatch nhanh theo Pick chọn hoặc Boundary

Quan trọng là có thích hay không mà thôi!
Rồi thì ai cũng phải tự hiểu những gì mình cần thôi, chứ yêu cầu mãi nghe đâu có ổn :) Các bác khác viết cho victor chắc chỉ mất đến 10p là cùng thôi, nhưng nếu không có bắt đầu thì chẳng bao giờ có kết quả!
VD 2 phút :

(defun c:hh ()
>>
Quan trọng là có thích hay không mà thôi!
Rồi thì ai cũng phải tự hiểu những gì mình cần thôi, chứ yêu cầu mãi nghe đâu có ổn :) Các bác khác viết cho victor chắc chỉ mất đến 10p là cùng thôi, nhưng nếu không có bắt đầu thì chẳng bao giờ có kết quả!
VD 2 phút :

(defun c:hh ()
(acet-sysvar-set (list "HPNAME" "SOLID"))
(initget "B P")
(if (= (getkword "Boundary / Point :") "B")(command "-hatch" "S")(command "-hatch"))
(acet-sysvar-restore)
)

Hoàn toàn đâu có khó victor :) ?
Trên diễn đàn đầy người hướng dẫn, mà cơ bản có đọc, làm thử, hỏi để người ta hướng dẫn đâu!
<<

Filename: 178321_hh.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 89961
Tên lệnh: chonthuc
Chọn text là số
Các lisp trên có nhược điểm là sau khi chọn text rồi mới kiểm tra xem text đó là số hay không. Lisp dưới đây chỉ chọn text số luôn mà không cần mã lệnh kiểm tra.

Lisp chọn số thực:

Filename: 89961_chonthuc.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 89961
Tên lệnh: chonnguyen
Chọn text là số
Các lisp trên có nhược điểm là sau khi chọn text rồi mới kiểm tra xem text đó là số hay không. Lisp dưới đây chỉ chọn text số luôn mà không cần mã lệnh kiểm tra.

Lisp chọn số thực:

Filename: 89961_chonnguyen.lsp
Tác giả: lp_hai
Bài viết gốc: 178451
Tên lệnh: ic
Làm sao để chỉnh bé kích thước cái mũi tên này !

Hi, mình cũng tập tành viết cái lisp mong là có ích cho bạn.
Nguyên lý hoạt động là bạn phải chọn những thằng mũi tên, rồi lisp sẽ thay thế các mũi tên này bằng một block. trong file mình gửi đây là block có tên Girl, hình dạng thì mình scale mũi tên nhỏ chút xíu, bạn có thể chỉnh sửa cái block này theo dúng ý bạn. bạn cũng có thể thay đổi tên block nhưng lúc này bạn phải thay đổi...
>>

Hi, mình cũng tập tành viết cái lisp mong là có ích cho bạn.
Nguyên lý hoạt động là bạn phải chọn những thằng mũi tên, rồi lisp sẽ thay thế các mũi tên này bằng một block. trong file mình gửi đây là block có tên Girl, hình dạng thì mình scale mũi tên nhỏ chút xíu, bạn có thể chỉnh sửa cái block này theo dúng ý bạn. bạn cũng có thể thay đổi tên block nhưng lúc này bạn phải thay đổi luôn tên trong lisp nhá!
đây là file cad có block Gilr là cái mũi tên màu đỏ nha:
http://www.mediafire..._cau%5B2%5D.dwg

(defun c:ic (/ dt sdt ent id ang p1 p2 os)
(setq dt (ssget)
sdt (sslength dt)
id 0
os (getvar "osmode"))
(command "undo" "be")
(setvar "osmode" 0)
(repeat sdt
(setq ent (ssname dt id)
id (1+ id)
p1 (vlax-curve-getPointAtParam ent 0)
p2 (vlax-curve-getPointAtParam ent 1)
ang (/(*(angle p1 p2)180)pi)
)
(command "insert" "Girl" p1 "1" "" ang)
(entdel ent)
)
(setvar "osmode" os)
(command "undo" "end")
)

<<

Filename: 178451_ic.lsp
Tác giả: lp_hai
Bài viết gốc: 178458
Tên lệnh: sw
Làm sao để chỉnh bé kích thước cái mũi tên này !
Để chọn những "Mũi tên vàng" dễ dàng, bạn có thể xài lisp sau. và chú ý là gõ lệnh sw xong, chọn một mũi tên màu vàng, lisp sẽ chọn cho bạn những mũi tên giống nhau. sau đó gõ liếp lệnh ic

(defun c:sw(/ aaa ls dt dt1 sdt sdt1 ent ent1 id id1)
(setq AAA(SSGET)
sdt (sslength AAA)
id 0
dt (ssadd)
)
(repeat sdt;;repeat1
(setq ent (ssname AAA id)
id (1+ id)
>>
Để chọn những "Mũi tên vàng" dễ dàng, bạn có thể xài lisp sau. và chú ý là gõ lệnh sw xong, chọn một mũi tên màu vàng, lisp sẽ chọn cho bạn những mũi tên giống nhau. sau đó gõ liếp lệnh ic

(defun c:sw(/ aaa ls dt dt1 sdt sdt1 ent ent1 id id1)
(setq AAA(SSGET)
sdt (sslength AAA)
id 0
dt (ssadd)
)
(repeat sdt;;repeat1
(setq ent (ssname AAA id)
id (1+ id)
);;setq
(setq ls (entget ent))
(if (= (cdr (assoc 0 ls)) "INSERT")
(get-block ent)
(setq dt1(ssget"all"(list(assoc 0 ls) (assoc 8 ls))))
);;if
(setq sdt1 (sslength dt1)
id1 -1)
(while (setq ent1(ssname dt1 (setq id1 (1+ id1))))
(setq dt (ssadd ent1 dt))
);;While
(sssetfirst dt dt)
);;repeat1
(princ (strcat "\nco " (rtos (sslength dt)) " doi tuong." ))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-block(entm / sdtb idb ent2 entb dtm namem name BBB entb)
(setq dtm (vlax-ename->vla-object entm))
(setq namem (if(vlax-property-available-p dtm 'effectivename)
(vla-get-effectivename dtm)
(vla-get-name dtm)
));;;
(setq BBB(SSGET "all" (list(cons 0 "INSERT") (assoc 8 (entget entm))))
sdtb (sslength BBB)
idb 0
dt1 (ssadd)
)
(repeat sdtb;;repeat1
(setq entb (ssname BBB idb)
idb (1+ idb)
)
(setq ent2(vlax-ename->vla-object entb))
(setq name (if(vlax-property-available-p ent2 'effectivename)
(vla-get-effectivename ent2)
(vla-get-name ent2)
))
(if (= name namem)
(setq dt1 (ssadd entb dt1))
)
)
)

<<

Filename: 178458_sw.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 178447
Tên lệnh: vtg
Lisp thao tác trong 3D
Tiếc là phần vẽ thép góc của tôi nó nằm trong 1 chương trình chung cho nhiều vấn đề, đã chuyển qua vlx, trong khi các file lsp và dcl liên quan thì tìm mãi không ra, nên post lên cho bạn cái đơn giản nhất: vẽ tiết diện thép góc theo TCVN. Từ tiết diện này bạn có thể dùng thêm lệnh Sweep để vẽ nó trong không gian như bạn Hoan2182 đã hướng dẫn, hoặc bạn nào rảnh thì có thể giúp bạn viết bằng...
>>
Tiếc là phần vẽ thép góc của tôi nó nằm trong 1 chương trình chung cho nhiều vấn đề, đã chuyển qua vlx, trong khi các file lsp và dcl liên quan thì tìm mãi không ra, nên post lên cho bạn cái đơn giản nhất: vẽ tiết diện thép góc theo TCVN. Từ tiết diện này bạn có thể dùng thêm lệnh Sweep để vẽ nó trong không gian như bạn Hoan2182 đã hướng dẫn, hoặc bạn nào rảnh thì có thể giúp bạn viết bằng lisp vậy.
Thân thương!

<<

Filename: 178447_vtg.lsp
Tác giả: 790312
Bài viết gốc: 178671
Tên lệnh: oca
Lisp copy tăng dần.
Đây là lisp do bác Bình viết:

(defun C:OCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
e0 (car (entsel "\nSelect attribute block:"))
e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq name (getstr "\n Entering the attribute name: "))
(while (/= (cdr (assoc 2 (entget e))) name)
(setq e...
>>
Đây là lisp do bác Bình viết:

(defun C:OCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
e0 (car (entsel "\nSelect attribute block:"))
e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq name (getstr "\n Entering the attribute name: "))
(while (/= (cdr (assoc 2 (entget e))) name)
(setq e (entnext e))
)
(if e
(progn
(setq
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point : "))
(command "copy" e0 "" p1 p2)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
(setq
dat (entget (entnext (entlast)))
dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
(command "regen")
)
)
)
(princ)
)

Nhưng khi sử dụng nó báo lỗi error: no function definition: GETSTR.Nhờ các bác xem và chỉnh sửa giùm.Thanks.
<<

Filename: 178671_oca.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 178717
Tên lệnh: ha
tính khối lượng trên 1 m dài
Text kết quả to/nhỏ/mập/ốm thế nào, ghi vào đâu hay là ghi vào 1 text có sẵn trên bản vẽ. Chuyện này không khó nhưng bạn y/c càng rõ càng tốt, để đỡ tốn công sửa lại.
Thân thương!
P/S: trong khi chờ bạn, hãy dùng thử cái này xem sao đã.

Filename: 178717_ha.lsp
Tác giả: tuvn254
Bài viết gốc: 61431
Tên lệnh: a2
Tác giả: tiendung89
Bài viết gốc: 178739
Tên lệnh: vmc
Lisp vẽ mặt cắt từ bình đồ
-em có down lisp vẽ mặt cắt từ bình đồ của bác Hoành về dùng nhưng vừa Ap vào thì máy lại báo lỗi, mặc dù em đã làm đúng yêu cầu rồi, lỗi như sau:

Command: ap APPLOAD 4292_vmc.lsp successfully loaded.
Command: ; error: misplaced dot on input
Command:
em ko biết vì sao có lỗi này, mong các bác giúp đỡ cho ạ, lisp như sau:



;; free lisp from cadviet.com
;;; this lisp...
>>
-em có down lisp vẽ mặt cắt từ bình đồ của bác Hoành về dùng nhưng vừa Ap vào thì máy lại báo lỗi, mặc dù em đã làm đúng yêu cầu rồi, lỗi như sau:

Command: ap APPLOAD 4292_vmc.lsp successfully loaded.
Command: ; error: misplaced dot on input
Command:
em ko biết vì sao có lỗi này, mong các bác giúp đỡ cho ạ, lisp như sau:



;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...p?showtopic=812
;; Bien toan cuc deltaH
(defun c:vmc ( / sel)
(defun luuos ()
(setq
HOANH_OSMODE (getvar "OSMODE")
HOANH_AUTOSNAP (getvar "AUTOSNAP")
)
)
(defun traos ()
(if HOANH_OSMODE
(setvar "OSMODE" HOANH_OSMODE)
)
(if HOANH_AUTOSNAP
(setvar "AUTOSNAP" HOANH_AUTOSNAP)
)
)
(defun GiaoDT (ent1 ent2)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value
(vla-IntersectWith ob1 ob2 acExtendNone)
)
)
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)
)
(defun NhapdeltaH( / tmp)
(while (not tmp)
(setq tmp (getdist "\nVao khoang cach deltaH: "))
(if (not tmp)
(setq tmp deltaH)
)
)
(setq deltaH tmp)
)
;;;---------------------- Main --------------------------------
(princ "\nVMC &#169; CADViet.com")
(if (not deltaH)
(NhapdeltaH)
)
(while (not sel)
(setq sel (entsel "\nVao line mat cat (hoac nhan Enter de nhap deltaH): ")
entl (car sel)
)
(if (not sel)
(NhapdeltaH)
)
)
(if (= "LINE" (cdr (assoc 0 (entget entl))))
(progn
(setq
p (cadr sel)
tt (entget entl)
p1 (cdr (assoc 10 tt))
p2 (cdr (assoc 11 tt))
)
(if (> (distance p p1)
(distance p p2)
)
(setq p p1
p1 p2
p2 p
)
)
(luuos)
(setvar "osmode" 0)
(command ".zoom" p1 p2)
(setq
sspl (ssget "F"
(LIST P1 P2)
'((-4 . "<or") (0="" .="" "lwpolyline")="" "spline")="" (-4="" "or="">")
)
)
tappl (ss2ent sspl)
goc (+ (angle p1 p2) (/ pi 2.0))
index 0
tappn nil
)
(command ".zoom" "p")
(foreach entpl tappl
(if (setq tmp (giaodt entpl entl))
(setq
p (car tmp)
pn (polar p goc (* deltaH index))
index (1+ index)
tappn (append tappn (list pn))
)
)
)
(command ".pline")
(foreach pn tappn
(command pn)
)
(command "")
(traos)
)
)
(princ)
)
(vl-load-com)
(princ "\nVe mat cat tu binh do &#169; CADViet.com 2007")
(princ "\nDung lenh VMC de bat dau!")
(princ)

</or")>

<<

Filename: 178739_vmc.lsp
Tác giả: nestxanh
Bài viết gốc: 179066
Tên lệnh: n
Nhờ mọi người sửa hộ lisp đo diện tích
Mình có một lisp đo diện tích vùng khép kín rồi điền giá trị vào Dtext, cũng ko nhớ xin của ai, nếu ai trong diễn đàn nhớ ra là code của mình thì cho gửi lời cám ơn nhé. Mình muốn nhờ thêm mọi người sửa hộ code để sau khi điền giá trị diện tích vào text thì mầu text được thay đổi để dễ nhận biết, mầu nào cũng đc miễn là khác mầu cũ của text.

Code file lisp mà mình có:
>>
Mình có một lisp đo diện tích vùng khép kín rồi điền giá trị vào Dtext, cũng ko nhớ xin của ai, nếu ai trong diễn đàn nhớ ra là code của mình thì cho gửi lời cám ơn nhé. Mình muốn nhờ thêm mọi người sửa hộ code để sau khi điền giá trị diện tích vào text thì mầu text được thay đổi để dễ nhận biết, mầu nào cũng đc miễn là khác mầu cũ của text.

Code file lisp mà mình có:
(defun c:N()
(if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
(setq ntl (/ 100 tl))
(setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 3 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tl2))
(print dtl)
(setq elst (entget (car (entsel "Thay cho so: "))))
(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
; (setq pt2 (getpoint "\nPoint to write: "))
; (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun


Xin chân thành cảm ơn!
<<

Filename: 179066_n.lsp
Tác giả: ketxu
Bài viết gốc: 178829
Tên lệnh: test
Ghép DText

- Phiên bản pick đến đâu nối đến đó

Filename: 178829_test.lsp
Tác giả: thiep
Bài viết gốc: 179020
Tên lệnh: hmc
Lisp vẽ mặt cắt từ bình đồ


;;;------------ve hinh chieu mat cat ------
;;;------------by THIEP /11/2011 ------
(defun c:hmc (/ entl sel ss pa pb L0 L1 L2 Lstp)
(vl-load-com)
(command "undo" "be")
(acet-sysvar-set
(list "cmdecho" 0 "osmode" 0)
)
(while (not sel)
(setq sel (entsel "\nPick line mat cat: ")
entl (car sel)
)
)
(setq PA (vlax-curve-getStartPoint...
>>


;;;------------ve hinh chieu mat cat ------
;;;------------by THIEP /11/2011 ------
(defun c:hmc (/ entl sel ss pa pb L0 L1 L2 Lstp)
(vl-load-com)
(command "undo" "be")
(acet-sysvar-set
(list "cmdecho" 0 "osmode" 0)
)
(while (not sel)
(setq sel (entsel "\nPick line mat cat: ")
entl (car sel)
)
)
(setq PA (vlax-curve-getStartPoint entl)
PB (vlax-curve-getEndPoint entl)
)
(setq ss (ssget "F"
(list pA pB)
'((0 . "LWPOLYLINE,POLYLINE"))
)
L0 (acet-ss-to-list ss)
L1 nil
L2 nil
)
(foreach x L0
(setq L1 (append L1 (list(vla-copy (vlax-ename->vla-object x)))))
)
(mapcar '(lambda (x)
(vla-put-Elevation x 0.0)
)
L1
)
(foreach ent L1
(setq Lstp (acet-geom-intersectwith
entl
(vlax-vla-object->ename ent)
0
)
)
(foreach P Lstp
(setq L2 (append L2 (list P)))
)
)
(mapcar 'vla-Delete L1)
(setq L2 (append (list pa) L2)
L2 (append L2 (list pb))
L2 (vl-sort L2 '(lambda (e1 e2) (< (car e1) (car e2))))
)
(ACET-LWPLINE-MAKE (list L2))
(setq ss (SSADD (entlast) (SSADD)))
(command ".move"
ss
""
pa
(ACET-SS-DRAG-MOVE
SS
pa
"\nChon vi tri dat hinh chieu mat cat: "
)
)
(ACET-SYSVAR-RESTORE)
(command "undo" "end")
(princ "\nChuc cac ban thanh cong! Thiep")
(princ)
)
(princ "\nDung lenh HMC de bat dau!")

Bạn dùng thử lisp trên nhé. Nó là trích đoạn (1 phần 10) của lisp vẽ MC từ bình đồ.
<<

Filename: 179020_hmc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 179448
Tên lệnh: glt
Lisp tính lý trình các điểm trên 1 polyline/line

Hề hề hề
Phải chăng bạn cần cái này:

Hề hề hề.
@ phamxuanly gtvt: hãy gửi bản vẽ bị lỗi lên...

Filename: 179448_glt.lsp

Trang 60/304

60