Jump to content
InfoFile
Tác giả: Doan Van Ha
Bài viết gốc: 217181
Tên lệnh: taoc
[ xin lisp ] đổi chiều đối tượng ( đường cong , thẳng , gấp khúc )

http://www.kosovalindore.com/2014/01/15/cila-ishte-fytyra-e-vertete-e-titos-per-shqiptaret/ hose pose viagra batch numbers encyclopedia “We know that there were a large number of people around the Kilburn High Road area in the early hours of Saturday August 24 and we believe that there are members of the public who have heard information about the shooting and I would urge them to contact us.”

Filename: 217181_taoc.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 88123
Tên lệnh: cong
Cộng đều hoặc trừ các text với một số.

Ví dụ T1,T2 thành T101,T102...

Filename: 88123_cong.lsp
Tác giả: duy782006
Bài viết gốc: 218463
Tên lệnh: dtlay
[Yeu cau] Lsp chuyển tên layer các đối tượng
:angry2:

(defun renamelayer (tencu tenmoi maumoi)
(cond
((/= (tblsearch "layer" tencu) nil)
(command ".-rename" "la" tencu tenmoi)
(command ".-layer" "s" tenmoi "co" maumoi "" "")
))
)
(defun c:dtlay ()
(mapcar 'renamelayer
(list...
>>
:angry2:

(defun renamelayer (tencu tenmoi maumoi)
(cond
((/= (tblsearch "layer" tencu) nil)
(command ".-rename" "la" tencu tenmoi)
(command ".-layer" "s" tenmoi "co" maumoi "" "")
))
)
(defun c:dtlay ()
(mapcar 'renamelayer
(list "10" "22" "57")
(list "a1-10" "a1-22" "a1-57")
(list "20" "30" "40")
)
(princ))

<<

Filename: 218463_dtlay.lsp
Tác giả: nhoclangbat
Bài viết gốc: 218239
Tên lệnh: test
lsp tách 1 nhóm layer thành nhiều layer khác nhau
file của bạn mình xem thử rùi, mà bạn dùng lsp nào lsp của anh ket hay anh HHVD, nếu bạn dùng lsp của anh ket thì nếu trước tiên những đối tượng đó là block phải phá block và chỉ đổi layer đc khi trong file đã có sẵn 3 layer cần đổi, anh ket đã kêu mình nếu trong file ko có layer đó thì trong lsp phải có thêm lệnh tạo các layer đó, lsp mới thực thi đc, còn lsp của anh HHVD thì ko cần phá block quét...
>>
file của bạn mình xem thử rùi, mà bạn dùng lsp nào lsp của anh ket hay anh HHVD, nếu bạn dùng lsp của anh ket thì nếu trước tiên những đối tượng đó là block phải phá block và chỉ đổi layer đc khi trong file đã có sẵn 3 layer cần đổi, anh ket đã kêu mình nếu trong file ko có layer đó thì trong lsp phải có thêm lệnh tạo các layer đó, lsp mới thực thi đc, còn lsp của anh HHVD thì ko cần phá block quét chọn hết đối tượng đó chạy lsp tự động tạo ra các layer đó, tự phá block và chuyển layer lun, trường hợp file của bạn đã có nhửng layer đó rùi, những đối tượng đó ko còn là block nữa thì chỉ cần dùng lsp của anh ket là ok mình cũng đã thử, nếu file bản đồ gốc của bạn đối tượng đó là block thì dùng lsp của anh HHVD. nếu trong file của bạn ko có sẵn những layer đó thì mình sẽ psot lsp của anh ket mà anh ket chỉ mình nếu mún lsp tự tạo các layer đó thì thêm vài dòng lệnh là ok, mình đã mò mẫn và sữa lại thành công hihi.
PS: dùng lsp của anh HHVD thì đối tượng đó phải là block nha bạn, nếu đã phá block rùi thì dùng ko đc đâu.
lsp của anh ket mình đã chỉnh sữa

(defun c:test(/ ss a )(vl-load-com)
(COMMAND "LAYER" "M" "SOTHUA" "C" "3" "" "")
(COMMAND "LAYER" "M" "DIENTICH" "C" "3" "" "")
(COMMAND "LAYER" "M" "LOAIRUONGDAT" "C" "3" "" "")
(setq a '((INT . "SOTHUA")(REAL . "DIENTICH")(SYM . "LOAIRUONGDAT"))
tmp (ssget (list (cons 0 "TEXT")(cons 8 "13")))
)
(vlax-for x (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq tmp (assoc (type (read (vla-get-textstring x))) a))
(vla-put-layer x (cdr tmp))
)
)
)

<<

Filename: 218239_test.lsp
Tác giả: hochoaivandot
Bài viết gốc: 218528
Tên lệnh: ttt
Lisp điền cao độ cho line, pline !


(defun C:ttt(/ cd ss)
(setq cd (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do")))))))
(setq ss (ssget '((0 . "*LINE"))))
(command "change" ss "" "P" "E" cd "")
)

Filename: 218528_ttt.lsp
Tác giả: avi612
Bài viết gốc: 218620
Tên lệnh: gtb
Xin Lisp tính giá trị trung bình các text
Lisp tính giá trị trung bình của các Text cho bạn đây..!

Filename: 218620_gtb.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 218602
Tên lệnh: ha
[Yêu cầu] Lisp xóa điểm trùng và sắp xếp lại đỉnh của LWPolyline
Nếu nhằm mục đích xóa tất cả các điểm trùng nhau của 1 Lwpolyline bất kỳ, không phân biệt có arc hay không, thì dùng lisp này (còn nếu có thêm điều kiện là chỉ xóa các điểm liên tiếp mà trùng nhau thì phải sửa lisp tí):

Filename: 218602_ha.lsp
Tác giả: quansla
Bài viết gốc: 219181
Tên lệnh: chon
[Yêu cầu] Lisp ghi kích thước Polyline ra text
Bạn có thể thứ
Tên lệnh "CHON"
Cách sử dụng
Pick chọn Dim1 (dùng để lấy chiều dài- giá trị đầu tiên sau chữ PL)
Pick chọn Dim2 (dùng để lấy chiều rộng_giá trị cuối của Text)
Pick chọn text bị thay đổi

(defun c:chon (/ ent1 ent2 ass1 ass2 X1 X2 X day NDnew)
(setvar "cmdecho" 0)
(or #day# (setq #day# 10))
(command "undo"...
>>
Bạn có thể thứ
Tên lệnh "CHON"
Cách sử dụng
Pick chọn Dim1 (dùng để lấy chiều dài- giá trị đầu tiên sau chữ PL)
Pick chọn Dim2 (dùng để lấy chiều rộng_giá trị cuối của Text)
Pick chọn text bị thay đổi

(defun c:chon (/ ent1 ent2 ass1 ass2 X1 X2 X day NDnew)
(setvar "cmdecho" 0)
(or #day# (setq #day# 10))
(command "undo" "begin")
(setq ass1 (cdr(assoc 1 (setq ent1 (entget(car (entsel "\nChon Dim1") )))))
ass2 (cdr(assoc 1 (setq ent2 (entget(car (entsel "\nChon Dim2") )))))
)
(if (= ass1 "")
(setq X1 (cdr(assoc 42 ent1))) ;;rong
(setq X1 (atof ass1)))
(if (= ass2 "")
(setq X2 (cdr(assoc 42 ent2))) ;;dai
(setq X2 (atof ass2)))
(if (< X2 X1)
(progn
(setq X X2
X2 X1
X1 X)
))
(setq #day# (cond ((getreal (strcat "\nNhap chieu day <" (rtos #day# 2 0) ">:")))(#day#)))
(setq NDnew (strcat "PL" (rtos X1 2 0) "x" (rtos #day# 2 0) "x" (rtos X2 2 0 )))
(setq dt (entget(car(entsel "\nChon Text"))))
(entmod(subst (cons 1 NDnew) (assoc 1 dt) dt))
(command "undo" "end")
(setvar "cmdecho" 1)
)


uẩy còn vụ Fake dim nữa để mình sửa lại đã
Ok giờ thì xong rồi, hơi loằng ngoằng nhưng nói chung là đủ dùng
Đã sửa lại cú pháp text viết ra là rộng x dày x dài, sorry bạn
<<

Filename: 219181_chon.lsp
Tác giả: Tue_NV
Bài viết gốc: 219392
Tên lệnh: vsr
[Đố vui] Vẽ hình chữ nhật bao quanh khung nhìn hiện tại trong Model

Dùng acet thì chỉ thế này thôi

Filename: 219392_vsr.lsp
Tác giả: LoveLisp
Bài viết gốc: 219602
Tên lệnh: br2p
cắt pline thành các đoạn theo chiểu dài chọn

Chọn các đối tượng, pick 2 điểm, các đối tượng sẽ bị ngắt tại giao đường thẳng nối 2 điểm

Filename: 219602_br2p.lsp
Tác giả: bach1212
Bài viết gốc: 212397
Tên lệnh: dcd
Nhờ các bác viết dùm Lisp đánh cao độ

Với code ở bài #24, đã sửa theo gợi ý của Ketxu. Nhưng chưa bớt được thao tác nhập ban đầu: chọn blog mẫu

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=12103&st=20
(defun c:dcd(/ blname dmo cdm cd dm cdmi dmoc bl)
(setvar "attreq" 1)
(setvar "cmdecho" 0)
(setq oldim (getvar "DimZin"))
(setvar...
>>

Với code ở bài #24, đã sửa theo gợi ý của Ketxu. Nhưng chưa bớt được thao tác nhập ban đầu: chọn blog mẫu

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=12103&st=20
(defun c:dcd(/ blname dmo cdm cd dm cdmi dmoc bl)
(setvar "attreq" 1)
(setvar "cmdecho" 0)
(setq oldim (getvar "DimZin"))
(setvar "Dimzin" 0)
(or tlv (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/"))))
(or bl (setq bl (car(entsel "\n Pick chon Block mau / Text mau :"))))
(or blm (setq blm (entget bl)))
(setq dmo (getpoint "\n Pick diem moc : "))
(setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao
do : "))
(if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick
text cao do : "))))))) )
(if cdm (progn
(if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2))))
(if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2))))
(if (< cdm 0) (setq cd (rtos cdm 2 2)))
(setq dmoc dmo)
(while (setq dm (getpoint dmoc "\n Pick diem tiep theo :"))
(if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo))
tlv) cdm) ) )
(if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr
dm)) tlv) ) ) )
(if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2))))
(if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2))))
(if (< cdmi 0) (setq cdi (rtos cdmi 2 2)))
(command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm)
(if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (=
(cdr(assoc 66 (entget (entlast)))) 1))
(setq el (entget (entnext (entlast)) )))
(if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget
(entlast))) )
(entmod (subst (cons 1 cdi) (assoc 1 el) el))
(entupd (entlast))
(setq dmoc dm)
)
(setvar "Dimzin" oldim)
)))
(princ)
)


<<

Filename: 212397_dcd.lsp
Tác giả: avi612
Bài viết gốc: 219838
Tên lệnh: ltt
Lisp làm tròn số TEXT
Lần sau nhớ xác định rõ mục đích và yêu cầu của bạn trước khi nhờ người khác giúp nhá....

; Write by avi612
(defun C:LTT( / ss n i oldDimzin e d v S)

(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)

(if (not n0) (setq n0 2))
(setq
ss (ssget '((0 . "TEXT,MTEXT")))
n (getint (strcat "\nS\U+1ED1 ch\U+1EEF s\U+1ED1 th\U+1EADp ph&#226;n: <" (itoa...
>>
Lần sau nhớ xác định rõ mục đích và yêu cầu của bạn trước khi nhờ người khác giúp nhá....

; Write by avi612
(defun C:LTT( / ss n i oldDimzin e d v S)

(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)

(if (not n0) (setq n0 2))
(setq
ss (ssget '((0 . "TEXT,MTEXT")))
n (getint (strcat "\nS\U+1ED1 ch\U+1EEF s\U+1ED1 th\U+1EADp ph&#226;n: <" (itoa n0) ">"))
i 0
oldDimzin (getvar "dimzin")
)
(if n (setq n0 n) (setq n n0))
(setvar "dimzin" 1)
(repeat (sslength ss)
(setq e (ssname ss i))
(if (= (etype e) "MTEXT") (progn
(command "explode" e "")
(setq e (entlast))
))
(setq
d (entget e)
v (atof (cdr (assoc 1 d)))
S (rtos v 2 n)
d (subst (cons 1 S) (assoc 1 d) d)
)
(entmod d)
(setq i (1+ i))
)
(setvar "dimzin" oldDimzin)
(princ)
)

<<

Filename: 219838_ltt.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 220076
Tên lệnh: xr
Xóa text rỗng (không có nội dung)

Xóa các đối tượng text rỗng (có thể có 0 hoặc n dấu cách):

Tên lệnh lisp là XR (Xóa Rỗng)


Filename: 220076_xr.lsp
Tác giả: Tue_NV
Bài viết gốc: 69464
Tên lệnh: xt2c
Lệnh Di rồi xuất ra text theo 2 chiều!!

Bạn sử dụng Code này xem sao :

Filename: 69464_xt2c.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 220298
Tên lệnh: g2d g3d
Đường cong bậc 2 trong cad
Có 1 chút nhầm lẫn, tôi đã sửa ở link cũ. Và bạn có thể down trực tiếp cái này.
Lisp này dùng để vẽ đồ thị của các hàm số y=f(x) trong 2D và z=f(x,y) trong 3D.
Cách nhập: bạn xem trích dẫn dưới đây đối với ví dụ của bạn:
Command: g2d
Nhap cong thuc ham so theo dang bieu thuc CAL: x^2-2*x+1
Nhap gia tri Xmin: 0
Nhap gia tri Xmax: 10
Nhap so khoang chia: 10
Chon kieu ve ...
>>
Có 1 chút nhầm lẫn, tôi đã sửa ở link cũ. Và bạn có thể down trực tiếp cái này.
Lisp này dùng để vẽ đồ thị của các hàm số y=f(x) trong 2D và z=f(x,y) trong 3D.
Cách nhập: bạn xem trích dẫn dưới đây đối với ví dụ của bạn:
Command: g2d
Nhap cong thuc ham so theo dang bieu thuc CAL: x^2-2*x+1
Nhap gia tri Xmin: 0
Nhap gia tri Xmax: 10
Nhap so khoang chia: 10
Chon kieu ve <S>: S

<<

Filename: 220298_g2d_g3d.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 220261
Tên lệnh: 3dp
[ hỏi ] cách nối đường 3D để có 1 đường 3d kín
Đây là cái lisp của "người ta", dùng để nối các 3D Line thành 3D Polyline. Tôi đã test thử trên bản vẽ của bạn, thấy OK, nhưng lâu thì khỏi nói, vì polyline của bạn vô vàn điểm!
Cách dùng:
1). Vẽ 2 LINE nối 2 đầu của cặp POLYLINE.
2). EXPLODE 2 POLYLINE ra thành 1 mớ LINE.
3). Load và dùng lisp: chọn tất cả đối tượng gồm: 2 line + đống line do explode sinh ra => pha cà phê...
>>
Đây là cái lisp của "người ta", dùng để nối các 3D Line thành 3D Polyline. Tôi đã test thử trên bản vẽ của bạn, thấy OK, nhưng lâu thì khỏi nói, vì polyline của bạn vô vàn điểm!
Cách dùng:
1). Vẽ 2 LINE nối 2 đầu của cặp POLYLINE.
2). EXPLODE 2 POLYLINE ra thành 1 mớ LINE.
3). Load và dùng lisp: chọn tất cả đối tượng gồm: 2 line + đống line do explode sinh ra => pha cà phê nhâm nhi ít phút => có 1 POLYLINE liền nhau.

<<

Filename: 220261_3dp.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 220407
Tên lệnh: ha
Nhờ viết lisp canh chỉnh block trong bảng thống kê
Lisp Move Block vào tâm Rectangle và Scale để Block nằm gọn trong Rectangle.

Filename: 220407_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 220481
Tên lệnh: taolop
Tác giả: toiyeuvietnam
Bài viết gốc: 220597
Tên lệnh: khoa
[Nhờ giúp] đoạn code này có nút Close mà không phải là nút Ok
em dùng thử với đoạn code dưới đây, em muốn thêm phần hạn chế không cho khóa khi gõ lệnh khóa thì chuơng trình báo là bạn không được khóa bản vẽ và thoat khỏi chuơng trình

(defun c:KHOA ( / ss i j h e ) (prompt "\nGO LENH KHOA: DE KHOA BAN VE KHONG CHO SUA")
(if (setq ss (ssget))(progn(repeat(setq j 0 i (sslength ss))
(if (not(member(setq h(cdr(assoc 5(setq e(entget(ssname ss(setq i (1- i))))))))...
>>
em dùng thử với đoạn code dưới đây, em muốn thêm phần hạn chế không cho khóa khi gõ lệnh khóa thì chuơng trình báo là bạn không được khóa bản vẽ và thoat khỏi chuơng trình

(defun c:KHOA ( / ss i j h e ) (prompt "\nGO LENH KHOA: DE KHOA BAN VE KHONG CHO SUA")
(if (setq ss (ssget))(progn(repeat(setq j 0 i (sslength ss))
(if (not(member(setq h(cdr(assoc 5(setq e(entget(ssname ss(setq i (1- i)))))))) *handle*))
(setq *handle* (cons h *handle*) *elist* (cons e *elist*) j (1+ j))))
(if(not(vl-some(function(lambda ( r )(eq "ObjectLock" (vlr-data r))))
(cdar (vlr-reactors :vlr-editor-reactor))))
(vlr-editor-reactor "ObjectLock"(list(cons :vlr-commandended 'ObjectLockCallBack)(cons :vlr-lispended 'ObjectLockCallBack))))
(if(not(vl-some(function(lambda ( r )(eq "ObjectLock" (vlr-data r))))
(cdar (vlr-reactors :vlr-dwg-reactor))))
(vlr-dwg-reactor "ObjectLock"(list(cons :vlr-beginsave 'ObjectLockSave))))
(princ(strcat "\n"(itoa j) " Object(s) Locked, Total: " (itoa (length *handle*)) " Locked."))))
(prompt "\nDA KHOA CAC DOI TUONG VUA CHON XONG!")(princ))

<<

Filename: 220597_khoa.lsp
Tác giả: dothanhdatvtchd
Bài viết gốc: 220108
Tên lệnh: ll lgt lc ln lh l lmh
[ Nhờ chỉnh sửa ] Lisp link chiều dài đối tượng đến text
Em muốn nhờ các bác sửa giùm lisp "LL" _ link chiều dài đối tượng đến text.
Yêu cầu:
1. Sau khi chọn đối tượng cần tính chiều dài thì hiện thông báo hỏi: "Nhập số cần cộng thêm" để mình nhập vào, Sau đó chọn text đích. text đích sẽ hiển thị kết quả là chiều dài của đối tượng + số đã nhập.
Khi chiều dài đối tượng thay đổi, text đích thay đổi...
>>
Em muốn nhờ các bác sửa giùm lisp "LL" _ link chiều dài đối tượng đến text.
Yêu cầu:
1. Sau khi chọn đối tượng cần tính chiều dài thì hiện thông báo hỏi: "Nhập số cần cộng thêm" để mình nhập vào, Sau đó chọn text đích. text đích sẽ hiển thị kết quả là chiều dài của đối tượng + số đã nhập.
Khi chiều dài đối tượng thay đổi, text đích thay đổi theo.
2. (yêu cầu thêm, không liên quan đến yêu cầu 1, bác nào giúp em được thì tốt) Lisp này chỉ link chiều dài 1 đối tượng được chọn chứ không thể chọn nhiều đối tượng để tính tổng chiều dài, các bác cho em hỏi có thể link tổng chiều dài các đối tượng đã chọn đến text được không, khi 1 đối tượng thay đổi thì tất nhiên tổng chiều dài thay đổi và text cũng tự thay đổi theo.
Cảm ơn các bác nhiều
Lisp: http://www.cadviet.c...ln_lh_l_lmh.lsp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=40442&pid=76557&st=0&#entry76557
;;;====================================================================


========================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=cad2006)-------------------
;;;=============================================================================


===============
(vl-load-com)
;;;----------------------------------------
;;;LINK CHIEU DAI
(defun C:LL (/ obn Tkq)
(START_PG)
(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
obd (vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
ltr (I_INT0 "\n Nhap chu so lam tron" ltr)
hso (I_REAL "\n Nhap he so nhan" hso)
Tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"
"%pr" (rtos ltr 2 0) "%ct8" "\">%"
)
;ida (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
;(rtos (vla-get-objectid obn) 2 0) ">%).Length \\f \"%lu2%pr2%ct8\">%")
;ew (vlax-vla-object->ename (vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object))
;(vla-get-ownerid obd)))
)
(vla-put-textstring obd Tkq)
;(redraw ew 3)
;(entupd ew)
;(vla-update obw)
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;----------------------------------------
;;;LINK GIA TRI
(defun C:LGT (/ obn Tkq)
(START_PG)
(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
obd (vlax-ename->vla-object (car (nentsel "\nChon text dich")))
Tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid obn) 2 0)
">%).TextString>%"
)
)
(vla-put-textstring obd Tkq)
(vla-update obd)
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;----------------------------------------
;;;LINK TONG
(defun C:LC (/ obn Lob Tgt)
(START_PG)
(setq ltr (I_INT0 "\n Nhap chu so lam tron" ltr)
Tgt "%<\\AcExpr (0")
(foreach obn (setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))
(setq Tgt (strcat Tgt "+"
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)
">%).TextString>%"
)
)
)
(setq Tgt (strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
(EX_VALUE_T_P_L Tgt (car Lob))
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;----------------------------------------
;;;LINK TICH
(defun C:LN (/ Tgt obn Lob)
(START_PG)
(setq ltr (I_INT0 "\n Nhap chu so lam tron" ltr)
Tgt "%<\\AcExpr (1")
(foreach obn (setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))
(setq Tgt (strcat Tgt "*"
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)
">%).TextString>%"
)
)
)
(setq Tgt (strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
(EX_VALUE_T_P_L Tgt (car Lob))
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;----------------------------------------
;;;LINK HIEU
(defun C:LH (/ Tgt ent1 ent2)
(START_PG)
(setq ltr (I_INT0 "\n Nhap chu so lam tron" ltr))
(while (null (setq ss1 (ES_TM&D "\n Chon so bi tru..."))))
(while (null (setq ss2 (ES_TM&D "\n Chon so tru..."))))
(setq ent1 (car (C_S2L ss1))
ent2 (car (C_S2L ss2))
)
(setq Tgt (strcat "%<\\AcExpr ("
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)
">%).TextString>%"
"-" "%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)
">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"
)
)
(EX_VALUE_T_P_L Tgt ent1)
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;----------------------------------------
;;;LINK CHIA
(defun C:L/ (/ Tgt ent1 ent2)
(START_PG)
(setq ltr (I_INT0 "\n Nhap chu so lam tron" ltr))
(while (null (setq ss1 (ES_TM&D "\n Chon so BI CHIA..."))))
(while (null (setq ss2 (ES_TM&D "\n Chon so CHIA.."))))
(setq ent1 (car (C_S2L ss1))
ent2 (car (C_S2L ss2))
)
(setq Tgt (strcat "%<\\AcExpr ("
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)
">%).TextString>%" "/"
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)
">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"
)
)
(EX_VALUE_T_P_L Tgt ent1)
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;----------------------------------------
;;;LINK TONG
(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang
(START_PG)
(setq 42pan (I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)
ltr (I_INT0 "\n Nhap chu so lam tron" ltr)
hso (I_REAL "\n Nhap he so nhan" hso)
Lst1 (OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))
Lst2 (OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))
Lst3 (OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))
Tgt "%<\\AcExpr (0"
dem 0
)
(if (null Lst3)
(while (null (setq pt1 (getpoint "\n X dat cot: "))))
)
(if (/= (length Lst1) (length Lst2))
(progn
(alert "So hang cua 2 cot khong bang nhau. Chon lai")
(exit)
)
)
(repeat (length Lst1)
(setq ent1 (nth dem Lst1)
ent2 (nth dem Lst2)
)
(if Lst3
(setq ent3 (nth dem Lst3))
(setq ent3 nil)
)
(setq dem (1+ dem))
(cond ( (= 42pan "C")
(setq Tgt (CALC_LINK ent1 ent2 "+" ltr hso))
)
( (= 42pan "N")
(setq Tgt (CALC_LINK ent1 ent2 "*" ltr hso))
)
( (= 42pan "CH")
(setq Tgt (CALC_LINK ent1 ent2 "/" ltr hso))
)
)
(if (/= ent3 nil)
(progn
(setq ob (entget ent3))
(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))
)
(progn
(if (and (= (cadr (assoc 11 (entget ent1))) 0.0)
(= (caddr (assoc 11 (entget ent1))) 0.0)
)
(setq Tj 10)
(setq Tj 11)
)
(setq ent1 (entget ent1)
pt1 (list (car pt1) (caddr (assoc Tj ent1)))
)
(entmakex (list '(0 . "TEXT")
'(100 . "AcDbEntity")
(assoc 8 ent1)
'(100 . "AcDbText")
(cons Tj pt1)
(assoc 40 ent1)
(cons 1 Tgt)
(assoc 50 ent1)
(assoc 41 ent1)
(assoc 51 ent1)
(assoc 7 ent1)
(assoc 71 ent1)
(assoc 72 ent1)
'(100 . "AcDbText")
(assoc 73 ent1)
)
)
)
)
)
(vl-cmdf "regen")
(END_PG)
(princ)
)
;;;=============================================================================


===============
;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------
;;;=============================================================================


===============
(defun CALC_LINK (ent1 ent2 ptinh ltr hso)
(strcat "%<\\AcExpr ("
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)
">%).TextString>%"
ptinh
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)
">%).TextString>%" ") \\f \"%lu2" "%pr" (itoa ltr)
"%ct8\"" ">%"
)
)

(defun OWNER_ENAME (obn)
(vlax-vla-object->ename
(vla-objectidtoobject
(vla-get-activedocument (vlax-get-acad-object))
(vla-get-ownerid
(vlax-ename->vla-object obn)
)
)
)
)
;;;HAM BAY LOI
(defun INIT ()
(setq OLD_ERROR *error*
*error* MYERROR
)
(command "Undo" "begin")
)
(defun MYERROR (errmsg)
(cond
((= errmsg "quit / exit abort")
(princ)
)
((/= errmsg "Function cancelled")
(princ (strcat "\n Co loi: " errmsg))
)
)
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "DIMZIN" OLD_DIMZIN)
(setvar "clayer" OLD_CLAYER)
(setvar "CECOLOR" OLD_CECOLOR)
(setvar "cmdecho" 1)
(command "Undo" "end")
(DONE)
(prompt "\n Da Reset lai thiet lap ban dau")

)
(defun DONE ()
(if OLD_ERROR
(setq *error* OLD_ERROR)
)
)
;;;----------------------------------------------------------
;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH
(C:EXPRESSTOOLS)
(defun START_PG (/ ss)
(setq ss (ssget "I"))
(INIT)
(sssetfirst nil ss)
)
(defun END_PG ()
(DONE)
(RESTORE)
)
;;;----------------------------------------------------------
;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE ()
(setvar "cmdecho" 0)
(command "Undo" "begin")
(command "UCS" "W")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
OLD_CLAYER (getvar "clayer")
OLD_DIMZIN (getvar "DIMZIN")
)
(setvar "DIMZIN" 0)
)
(defun RESTORE ()
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "DIMZIN" OLD_DIMZIN)
(setvar "clayer" OLD_CLAYER)
(setvar "CECOLOR" OLD_CECOLOR)
(command "Undo" "end")
(setvar "cmdecho" 1)
(Grtext -1 "Copyright by Nataca - 0983.715.333")
)
;;;------------------------------------------
;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)
(defun I_INT0 (dongnhac Tso)
(if (null Tso)
(progn
(initget (+ 1 4))
(getint (strcat dongnhac " <?>:"))
)
(progn
(cond
((progn
(initget 4)
(getint (strcat dongnhac " < " (itoa Tso) " >:"))
)
)
(T Tso)
)
)
)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL (dongnhac Tso / Tso1)
(if (null Tso)
(progn
(initget (+ 1 2))
(setq Tso (getdist (strcat dongnhac " <?>:")))
(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))
Tso
)
(progn
(cond
((progn
(initget (+ 2))
(setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))
(if Tso1
(progn
(princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))
(setq Tso Tso1)
)
)
)
)
(T Tso)
)
)
)
)
;;;------------------------------------------
;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)
(defun ES_ENT_LMP (dongnhac / Lsel sel mouse ew) ;;;LMP = List Multi Pick
(prompt dongnhac)
(while (/= (car mouse) 2)
(setq mouse (grread 0 15 2))
(if (= (car mouse) 3)
(if (setq sel (car (nentselp (cadr mouse))))
(progn
(setq Lsel (append Lsel (list sel)))
(princ (strcat "\n" (itoa (length Lsel))
" doi tuong duoc pick chon/ENTER ke ket thuc chon"))
)
(princ "\nChon chua dung!")
)
)
)
Lsel
)
;;;------------------------------------------
;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)
(defun EX_VALUE_T_P_L (Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle)
;;;Real+interge
(prompt "\n Chon text chua kq / An enter de viet text kq...")
(while (and (/= (car mouse) 2) (null sel))
(setq mouse (grread 0 15 2))
(if (= (car mouse) 3)
(if (null (setq sel (car (nentselp (cadr mouse)))))
(princ "\nChon chua dung! Chon lai...")
)
)
)
(if (/= sel nil)
(progn
(setq ob (entget sel))
(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))
)
(progn
(while (null (setq pt1 (getpoint "\n Diem dat text: "))))
(if Tmau
(progn
(if (and (= (cadr (assoc 11 (entget Tmau))) 0.0)
(= (caddr (assoc 11 (entget Tmau))) 0.0)
)
(setq Tj 10)
(setq Tj 11)
)
(setq Tmau (entget Tmau))
(entmakex (list '(0 . "TEXT")
'(100 . "AcDbEntity")
(assoc 8 Tmau)
'(100 . "AcDbText")
(cons Tj pt1)
(assoc 40 Tmau)
(cons 1 Tkq)
(assoc 50 Tmau)
(assoc 41 Tmau)
(assoc 51 Tmau)
(assoc 7 Tmau)
(assoc 71 Tmau)
(assoc 72 Tmau)
'(100 . "AcDbText")
(assoc 73 Tmau)
)
)
)
)
)
)
)

;;;------------------------------------------
;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM&D (dongnhac / ss)
(while (and(not (prompt dongnhac))
(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))
(setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
)
)
)
)
ss
)
;;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun C_S2L (ss)
(if ss
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
nil
)
)
;;;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)
(if (null Text)
(progn
(initget 1 key)
(getkword (strcat dongnhac " :"))
)
(progn
(cond
((progn
(initget key)
(getkword (strcat dongnhac " < " Text " >:"))
)
)
(T Text)
)
)
)
)
(defun OD_SSY_DES_L (Lst)
(setq lst (vl-sort lst '(lambda (e1 e2)
(>
(caddr (assoc
(if (and (= (cadr (assoc 11 (entget e1))) 0.0)
(= (caddr (assoc 11 (entget e1))) 0.0)
)
10
11
)
(entget e1)
)
)
(caddr (assoc
(if (and (= (cadr (assoc 11 (entget e2))) 0.0)
(= (caddr (assoc 11 (entget e2))) 0.0)
)
10
11
)
(entget e2)
)
)
)
)
)
)
)
;;;------------------------------------------
;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
(while (and (not (prompt dongnhac))
(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))
(setq ss (ssget '((0 . "*TEXT"))))
)
)
)
)
ss
)
;;;CHON TEXT, MTEXT KEM DONG NHAC
(defun S_TM (dongnhac / ss)
(prompt dongnhac)
(if (null (setq ss (ssget "I" '((0 . "*TEXT")))))
(setq ss (ssget '((0 . "*TEXT"))))
)
ss
)

<<

Filename: 220108_ll_lgt_lc_ln_lh_l_lmh.lsp

Trang 108/330

108