Jump to content
InfoFile
Tác giả: NguyenNgocSon
Bài viết gốc: 194459
Tên lệnh: dstt
Code lisp ghép chuỗi

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=2460
(defun c:dstt (/ doc i ins lst)
(vl-load-com)
(defun sort_lst (lst dk)
(if (= dk "Left")
(vl-sort lst '(lambda (x y)
(or (< (car (cadr x)) (car (cadr y)))
(and (= (car (cadr x)) (car (cadr y)))
(< (cadr (cadr x)) (cadr (cadr y))) )) ))
(vl-sort lst '(lambda (x y)
>>

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=2460
(defun c:dstt (/ doc i ins lst)
(vl-load-com)
(defun sort_lst (lst dk)
(if (= dk "Left")
(vl-sort lst '(lambda (x y)
(or (< (car (cadr x)) (car (cadr y)))
(and (= (car (cadr x)) (car (cadr y)))
(< (cadr (cadr x)) (cadr (cadr y))) )) ))
(vl-sort lst '(lambda (x y)
(or (> (car (cadr x)) (car (cadr y)))
(and (= (car (cadr x)) (car (cadr y)))
(< (cadr (cadr x)) (cadr (cadr y))) )) ))) )

(if (ssget '((0 . "TEXT,mtext")))
(progn
(initget 0 "Left Right")
(setq tp (cond ((getkword (strcat "\nBat dau tu: <"
(cond (tp) ((setq tp "Right")) )
">: " ) ) )
(tp) ) )
(setq sbd (cond ((getint (strcat "\nVao so bat dau <"
(itoa (cond (sbd) ((setq sbd 1)) ) )
">: " ) ) )
(sbd) ) )
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vlax-for e (vla-get-ActiveSelectionSet doc)
(if (= (vla-get-Alignment e) 0)
(setq ins (vlax-get e 'InsertionPoint))
(setq ins (vlax-get e 'TextAlignmentPoint)) )
(setq lst (cons (list e ins )lst)))
(setq i (1- sbd)
lst (sort_lst lst tp )
lst (append (mapcar 'car lst) ) )
(foreach e lst
(vla-put-TextString e (itoa(setq i (1+ i)))) ) ))
(princ))

Mình có lisp này tải trên diễn đàn. Giờ mình muốn thêm tổng số đối tượng text được chọn sau hàm vla-put-TextString mà không biết code thế nào?
Ví dụ: số đối tượng chọn là 5 => lisp ĐSTT:1/05,2/05,3/05,4/05,5/05
Ví dụ: số đối tượng chọn là 12 => lisp ĐSTT:1/12,...,12/12
Cám ơn !
<<

Filename: 194459_dstt.lsp
Tác giả: Tue_NV
Bài viết gốc: 194462
Tên lệnh: dstt
Code lisp ghép chuỗi

Bạn tham khảo :

Filename: 194462_dstt.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 194475
Tên lệnh: dstt
Code lisp ghép chuỗi

Filename: 194475_dstt.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 194535
Tên lệnh: ha
Lấy FontFile của Font Name bất kỳ
Việc đặt Text Style bằng Dialoge là đã rõ ràng.
Tuy nhiên, việc đặt Text Style bằng lisp, dùng hàm (command "style"...), thường gặp trở ngại vì cần phải biết chính xác FontFile.
Chẳng hạn, Font Name là .VnArial NarrowH thì FontFile là gì? Trả lời: nó là Vharialn_0.ttf
Hoặc, Font Name là Times New Roman thì FontFile là gì? Trả lời: nó là times.ttf
Làm sao để biết được? Lisp này giúp...
>>
Việc đặt Text Style bằng Dialoge là đã rõ ràng.
Tuy nhiên, việc đặt Text Style bằng lisp, dùng hàm (command "style"...), thường gặp trở ngại vì cần phải biết chính xác FontFile.
Chẳng hạn, Font Name là .VnArial NarrowH thì FontFile là gì? Trả lời: nó là Vharialn_0.ttf
Hoặc, Font Name là Times New Roman thì FontFile là gì? Trả lời: nó là times.ttf
Làm sao để biết được? Lisp này giúp chúng ta lấy được FontFile chính xác ứng với từng Font Name.
Cách dùng:
1). Dùng lệnh Style để đặt 1 kiểu nào đó ứng với Font Name mà ta muốn biết FontFile.
2). Viết 1 Text ứng với kiểu đó ra screen.
3). Dùng lisp này để xác định FontFile của nó.

<<

Filename: 194535_ha.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 973
Tên lệnh: chb%252
Hatch
Lệnh hatchedit của ACAD đời mới có thể tạo lại đường biên của Hatch.
Nhưng vẫn còn một điều bất tiện là mỗi lệnh chỉ tạo được đường biên của 1 đối tượng Hatch.

Xin tặng các thành viên CADViet, mã lệnh lisp để tạo được nhiều đường biên một lúc với lệnh hatch edit này.


Filename: 973_chb%252.lsp
Tác giả: almodeus
Bài viết gốc: 130536
Tên lệnh: bf
Cắt đường thẳng tại điểm giao
trên diễn đàn mình có thấy có một lisp Break tại một điểm....lisp như sau:

(defun c:bf (/ dt diem)


(setq dt (car (entsel "\nVao doi tuong can chat")))
(if dt
(progn
(redraw dt 3)
(setq diem (getpoint "\nVao diem chat: "))
(redraw dt 4)
)
)
(if (and dt diem)
(command ".break" dt diem diem)
)
)



Các bạn có thể nâng...
>>
trên diễn đàn mình có thấy có một lisp Break tại một điểm....lisp như sau:

(defun c:bf (/ dt diem)


(setq dt (car (entsel "\nVao doi tuong can chat")))
(if dt
(progn
(redraw dt 3)
(setq diem (getpoint "\nVao diem chat: "))
(redraw dt 4)
)
)
(if (and dt diem)
(command ".break" dt diem diem)
)
)



Các bạn có thể nâng cấp nó lên theo chế độ click điểm cần cắt liên tục không, chứ mỗi lần lại gõ lệnh lại hơi phiền ...
Và nếu được thì nâng cấp thêm là thay vì cắt tại điểm click thì cắt tại điểm giao nhau:
1) ta chọn đối tượng cần chặt điểm có chế độ chọn nhiều đối tượng cùng lúc(gọi là đối tượng 1)
2) chọn đối tượng giao với nó chú ý là có chế độ chọn nhiều đường cùng lúc nha (đối tượng 2)
3) lệnh sẽ chặt đối tượng 1 được chọn tại những diểm giao với đố tượng 2 và đồng thời nó sẽ hỏi là đối tượng 2 có bị chặt điểm tại điểm giao luôn không (yes/no)

https://lh4.googleusercontent.com/_Zzz2Zg6R81w/TV4VrD5tnAI/AAAAAAAAABM/vZI38G7gU5o/s512/1111.jpg
mình có cái lisp này nhưng nó lại không cho chọn liên tục, và ko có chế độ thứ 3(defun c:Boj ()


(setq ent1 (car (setq ent (entsel "\nVao doi tuong can cat: "))))
(redraw ent1 3)
(setq ent2 (car (entsel "\nVao doi tuong dung de cat: ")))
(redraw ent1 4)
(setq giao (giaodt ent1 ent2))
(if giao
(foreach pp giao
(command "break" ent "f" pp "@")
)
(alert "2 doi tuong khong giao nhau!")
)
(princ)
)
(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
)
)


Bác nào có thể viết zùm cái lisp đó nhé (nếu kết hợp luôn cả chặt điểm tại click luon thi cang tot)
<<

Filename: 130536_bf.lsp
Tác giả: Tue_NV
Bài viết gốc: 66542
Tên lệnh: df
Tác giả: Doan Van Ha
Bài viết gốc: 194352
Tên lệnh: ha
viết lisp di chuyển rectang về spline.

Thử cái này coi đúng y/c của bạn không nhé? Còn không thì đọc ý kiến của bác Phamthanhbinh

Filename: 194352_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 194801
Tên lệnh: ha2
( Giúp đở).Phần nguyên và phần thập phân chia làm 2 text.

Cái này tôi đã post lên CADViet, sao bây giờ vào link cũ không được. Đành post lại vậy.
Bạn hết sức chú ý khi chọn text: chọn sao cho chúng đi đôi từng cặp nhé!

Filename: 194801_ha2.lsp
Tác giả: ketxu
Bài viết gốc: 194806
Tên lệnh: xoay
(Yêu cầu) Xin lisp làm 1 đường thẳng song song với 1 đường thẳng đã chọn

Quick code cho bạn :

(defun c:xoay(/ ST:Geom-Entity-Box-Fast mau Selset tmp)
(vl-load-com)
(defun ST:Geom-Entity-Box-Fast (vla-obj / ll lr ur ul rt)
(vla-getboundingbox vla-obj 'll 'ur)
(cons (mapcar '(lambda (x y) (* (+ x y) 0.5)) (setq ll (vlax-safearray->list ll))(setq ur (vlax-safearray->list ur))) (angle ll ur))
)
(if (and (princ "\nChon doi tuong mau :")
(setq mau (ST:Geom-Entity-Box-Fast...
>>
Quick code cho bạn :

(defun c:xoay(/ ST:Geom-Entity-Box-Fast mau Selset tmp)
(vl-load-com)
(defun ST:Geom-Entity-Box-Fast (vla-obj / ll lr ur ul rt)
(vla-getboundingbox vla-obj 'll 'ur)
(cons (mapcar '(lambda (x y) (* (+ x y) 0.5)) (setq ll (vlax-safearray->list ll))(setq ur (vlax-safearray->list ur))) (angle ll ur))
)
(if (and (princ "\nChon doi tuong mau :")
(setq mau (ST:Geom-Entity-Box-Fast (vlax-ename->vla-object (ssname (ssget ":S" (list (cons 0 "*LINE,LEADER"))) 0))))
(princ "\nChon cac doi tuong can quay :")
(ssget (list (cons 0 "*LINE,LEADER")))
(setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
)
(vlax-for object Selset
(vla-rotate object (vlax-3d-point (car (setq tmp (ST:Geom-Entity-Box-Fast object)))) (- (cdr mau)(cdr tmp)))
)
(vla-delete Selset)
)
)


Nếu muốn dùng cho tất cả các đối tượng (k riêng gì Pline, Line, Leader thì bạn xóa tất cả dòng này trong lisp đi
(list (cons 0 "*LINE,LEADER"))
<<

Filename: 194806_xoay.lsp
Tác giả: Tue_NV
Bài viết gốc: 194834
Tên lệnh: hvphan
(yêu cầu) lisp vẽ cung tròn với diện tích biết trước


Em có thể nêu cách vẽ của em được không?
Anh xây dựng được Lisp tính dần theo phương pháp gần đúng
Chính xác 4 con số 0 sau dấu phẩy, của em Chính xác 3 con số 0 sau dấu phẩy.
Đây là code

Filename: 194834_hvphan.lsp
Tác giả: ketxu
Bài viết gốc: 136094
Tên lệnh: clear1
Nhờ viết lisp dọn mặt bằng siêu tốc
Bạn thêm 1 dòng thôi là được. Tối r mình ngại upload quá, bạn chịu khó chép code nhé


Filename: 136094_clear1.lsp
Tác giả: nguyentienthanhddksct
Bài viết gốc: 194950
Tên lệnh: loctextso
loc các đối tượng dạng text số

Đây bạn:

;; free lisp from cadviet.com
(defun c:LocTextSo (/ ss ent str ss1)
(setq ss1 (ssadd))
(if (setq ss (ssget (list (cons 0 "TEXT"))))
(progn
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq str (cdr(assoc 1 (entget ent))))
(if (distof str 2)
(ssadd ent ss1)
)
)
(if (> (sslength ss1) 0)
(progn
(sssetfirst nil)
(princ...
>>
Đây bạn:

;; free lisp from cadviet.com
(defun c:LocTextSo (/ ss ent str ss1)
(setq ss1 (ssadd))
(if (setq ss (ssget (list (cons 0 "TEXT"))))
(progn
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq str (cdr(assoc 1 (entget ent))))
(if (distof str 2)
(ssadd ent ss1)
)
)
(if (> (sslength ss1) 0)
(progn
(sssetfirst nil)
(princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so."))
(sssetfirst nil ss1)
)
)
)
)
)

<<

Filename: 194950_loctextso.lsp
Tác giả: ketxu
Bài viết gốc: 194977
Tên lệnh: xoay
(Yêu cầu) Xin lisp làm 1 đường thẳng song song với 1 đường thẳng đã chọn
À, giờ mình đã hiểu ý bạn. Mình nói có thể sử dụng với các loại khác - không có nghĩa là áp dụng sẽ theo ý muốn chủ quan. Lisp trên sở dĩ lấy đường chéo của đường bao ảo (1 hình chữ nhật) của đối tượng làm cơ sở quay, nên nhiều trường hợp tất lẽ nó k đúng ý bạn :)
Update thêm cái...
>>
À, giờ mình đã hiểu ý bạn. Mình nói có thể sử dụng với các loại khác - không có nghĩa là áp dụng sẽ theo ý muốn chủ quan. Lisp trên sở dĩ lấy đường chéo của đường bao ảo (1 hình chữ nhật) của đối tượng làm cơ sở quay, nên nhiều trường hợp tất lẽ nó k đúng ý bạn :)
Update thêm cái Text hoặc Le :

(defun c:xoay(/ ST:Geom-Entity-Box-Fast mau Selset tmp)
(vl-load-com)
(defun ST:Geom-Entity-Box-Fast (vla-obj / ll lr ur ul rt)
(vla-getboundingbox vla-obj 'll 'ur)
(cons (mapcar '(lambda (x y) (* (+ x y) 0.5)) (setq ll (vlax-safearray->list ll))(setq ur (vlax-safearray->list ur))) (angle ll ur))
)
(if (and (princ "\nChon doi tuong mau :")
(setq mau (ST:Geom-Entity-Box-Fast (vlax-ename->vla-object (ssname (ssget ":S" ) 0))))
(princ "\nChon cac doi tuong can quay :")
(ssget)
(setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
)
(vlax-for object Selset
(setq typ (vla-get-ObjectName object))
(vla-rotate object (vlax-3d-point (car (setq tmp (ST:Geom-Entity-Box-Fast object))))
(- (cdr mau)
(cond ((wcmatch typ "AcDb*Text")
(vla-get-Rotation object))
((wcmatch typ "AcDb*Leader")
(angle
(car (setq tmp ((lambda(key lst / l )
(foreach x lst (if (= key (car x))(setq l (cons (cdr x) l))))
(reverse l)
) 10 (entget (vlax-vla-object->ename object))))
)
(last tmp)
)
)
(T (cdr tmp))
)
)
)
)
(vla-delete Selset)
)
)

<<

Filename: 194977_xoay.lsp
Tác giả: Tue_NV
Bài viết gốc: 71809
Tên lệnh: loctext
Viết Lisp theo yêu cầu

Bạn sử dụng cái này thử xem :
:cheers:

Filename: 71809_loctext.lsp
Tác giả: Tue_NV
Bài viết gốc: 104831
Tên lệnh: pllev
GHI CAO ĐỘ TUYẾN CỐNG

Bạn abc007 và hoa35ktxd thử code này nhé :


@Hoa35ktxd : Đây là code mà Tue_NV viết theo các ý trên :
Kiểm tra Chọn điểm đầu hoặc điểm cuối của Polyline, đồng thời chọn luôn Pline làm cơ sở tính toán
Nếu User chọn không đúng điểm đầu hoặc điểm cuối trên PLINE hoặc chọn trật thì Lisp sẽ báo câu :
Chon diem dau khong dung tren POLYline
Nếu không thích tính toán...
>>

Bạn abc007 và hoa35ktxd thử code này nhé :


@Hoa35ktxd : Đây là code mà Tue_NV viết theo các ý trên :
Kiểm tra Chọn điểm đầu hoặc điểm cuối của Polyline, đồng thời chọn luôn Pline làm cơ sở tính toán
Nếu User chọn không đúng điểm đầu hoặc điểm cuối trên PLINE hoặc chọn trật thì Lisp sẽ báo câu :
Chon diem dau khong dung tren POLYline
Nếu không thích tính toán viết Text, bác cứ Enter -> kết thúc lệnh

Vì Pline trên màn hình CAD : User không nhận ra đâu là điểm đầu, đâu là điểm cuối nên :
- Nếu User chọn đúng điểm đầu thì Lisp sẽ tính toán và viết Text từ điểm đầu đến điểm cuối
- Nếu User chọn đúng điểm cuối thì Lisp sẽ tính toán và viết Text từ điểm cuối đến điểm đầu

Lisp đúng trong trường hợp ống cống có đoạn bo cong
Bác thử nhé :D

Rất vui nếu được biết tên bác và làm quen với bác :D
<<

Filename: 104831_pllev.lsp
Tác giả: Tue_NV
Bài viết gốc: 195124
Tên lệnh: xoay
Tác giả: Doan Van Ha
Bài viết gốc: 195155
Tên lệnh: ha
Tác giả: Tue_NV
Bài viết gốc: 195209
Tên lệnh: gvert
Xin CODE đọc dữ liệu đường 2D POLYLINE

Code này đọc dữ liệu 2Dpolyline, xác định tọa độ đỉnh của Polyline này :
Quick code :

Filename: 195209_gvert.lsp
Tác giả: elleHCSC
Bài viết gốc: 11889
Tên lệnh: ds
Nhờ bác SSG sửa giùm hàm GetVert


Mục đích tôi sửa mấy cài hàm cũ này của bác SSG để đánh số thứ tự đỉnh vertex cho 1 PLine và đã ra được kết quả tạm thôi, tuy nhiên mục đích cuối cùng là khi CT chạy đối với 1 đối tượng là Close_pline (tôi quan niệm Pline_close là có X_start_point = X_end_point và Y_start_point = Y_end_point) thì số thứ tự đánh tôi đang cần là phải xuất phát từ đỉnh vertex có giá trị Y là lớn...
>>


Mục đích tôi sửa mấy cài hàm cũ này của bác SSG để đánh số thứ tự đỉnh vertex cho 1 PLine và đã ra được kết quả tạm thôi, tuy nhiên mục đích cuối cùng là khi CT chạy đối với 1 đối tượng là Close_pline (tôi quan niệm Pline_close là có X_start_point = X_end_point và Y_start_point = Y_end_point) thì số thứ tự đánh tôi đang cần là phải xuất phát từ đỉnh vertex có giá trị Y là lớn nhất.
Tôi định dùng hàm vl-sort để sort lại cái List L trong hàm Getvert của bác nhưng loay hoay mãi mà chưa đc nên pót lên nhờ bác chỉ giáo.
Thông cảm nha, tôi mới bập bẹ dùng Lisp từ khi tham gia CADVIET nên kỹ năng còn ít....
TKS !
<<

Filename: 11889_ds.lsp

Trang 83/330

83