Info | File |
Tác giả: t031285
Bài viết gốc: 168636
Tên lệnh: brk |
lisp cắt 1 đoạn thẳng
Lisp này e down từ diễn đàn,lisp này có tác dụng cắt 1 đoạn thẳng trong 1 đường thẳng và có cho ta lựa chọn thuộc tính của đoạn thẳng này.Nhưng khi muốn biến đoạn thẳng này thành nét đứt thì có 1 bất tiện e nhờ các bác sửa giúp như sau.
Trong bản vẽ có hệ số LTS là 1,
1.Có 1 đoạn thẳng là nét đứt và có LTS là 50 chẳng hạn.
2.Có 1 đường thẳng.
E dùng lisp...
>>
Lisp này e down từ diễn đàn,lisp này có tác dụng cắt 1 đoạn thẳng trong 1 đường thẳng và có cho ta lựa chọn thuộc tính của đoạn thẳng này.Nhưng khi muốn biến đoạn thẳng này thành nét đứt thì có 1 bất tiện e nhờ các bác sửa giúp như sau.
Trong bản vẽ có hệ số LTS là 1,
1.Có 1 đoạn thẳng là nét đứt và có LTS là 50 chẳng hạn.
2.Có 1 đường thẳng.
E dùng lisp này để cắt 1 đoạn thẳng trong đường thẳng 2 này và biến đoạn thẳng này thành đoạn thẳng 1 là nét đứt nhưng hệ số LTS chỉ là 1 theo bản vẽ chứ không theo LTS của đoạn thẳng 1 là 50,Nhờ các bác sửa giùm sao cho đoạn thẳng này thành nét đứt có LTS là 50 theo đúng đoạn thẳng đã chọn.Chân thành cảm ơn.
(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
(vl-load-com)
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(545 0 0))
(if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi :")) )
(progn
(setq cObj (vlax-ename->vla-object Ent)
pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
(if (> (vlax-curve-getParamAtPoint cObj pt1)
(vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp) )
(command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
(if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
(command "change" ent "" "p" "LA" (lcurr) "")
(progn
(command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
(command "change" (entlast) "" "p" "LA" (lcurr) "")
)
)
(redraw ent 4)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "undo" "e")
)
(alert "Khong hop le !"))
(princ))
;
(defun lcurr(/ e)
(setq str (getstring t "\n Nhap ten layer hoac Enter de pick vao doi tuong :"))
(if (= str "")
(progn
(while (null (setq e (entsel "\n pick vao doi tuong :"))))
(setvar "clayer" (cdr(assoc 8 (entget(car e)))))
)
(progn
(while (null (tblsearch "layer" str))
(setq str (getstring t "\n Nhap lai ten layer :"))
)
(setvar "clayer" str)
)
)
)
<<
|
Tác giả: ketxu
Bài viết gốc: 169086
Tên lệnh: brk |
lisp cắt 1 đoạn thẳng
.....
(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
(vl-load-com)
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(545 0 0))
(if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi...
>>
.....
(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
(vl-load-com)
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(545 0 0))
(if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi :")) )
(progn
(setq cObj (vlax-ename->vla-object Ent)
pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
(if (> (vlax-curve-getParamAtPoint cObj pt1)
(vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp))
(command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
(command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
(setq ent1 (vlax-ename->vla-object (car (entsel "\nDoi tuong mau :"))))
(if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
(setq ent (vlax-ename->vla-object ent))
(setq ent (vlax-ename->vla-object (entlast)))
)
(vla-put-layer ent (vla-get-layer ent1))
(vla-put-LinetypeScale ent (vla-get-Linetypescale ent1))
(redraw ent 4)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "undo" "e")
)
(alert "Khong hop le !"))
(princ))
<<
|
Tác giả: hoangtranlong
Bài viết gốc: 184910
Tên lệnh: tktd |
AutoLISP cho kỹ sư xây dựng
Xin mở đầu mục này bằng một tiện ích được viết bởi thành viên của chúng tôi.
Tiện ích viết từ Autolisp nhắm tiện dụng hoá...
>>
Xin mở đầu mục này bằng một tiện ích được viết bởi thành viên của chúng tôi.
Tiện ích viết từ Autolisp nhắm tiện dụng hoá phần thống kê thanh dàn , lệnh được gọi là tktd
(defun c:tktd( / lstThanh ss pp)
(defun sudung (ham ss / sodt index entdt soapp)
(setq sodt (cond
(ss (sslength ss))
(t 0)
)
soapp 0
index 0
)
(repeat sodt
(setq entdt (ssname ss index)
index (1+ index)
)
(if (ham entdt)
(setq soapp (1+ soapp))
)
)
soapp
)
(defun prone(ent / tt p1 p2 L cothem)
(defun them(dt)
(if (equal L (car dt) 1.0)
(progn
(setq cothem t)
(list L (1+ (cadr dt)))
)
dt
)
)
(setq
tt (entget ent)
p1 (cdr (assoc 10 tt))
p2 (cdr (assoc 11 tt))
L (distance p1 p2)
cothem nil
lstThanh (mapcar 'them lstThanh)
)
(if (not cothem)
(setq lstThanh
(append lstThanh (list (list L 1))
)
)
)
)
;;-------- Main ------------------
(princ "\nHay chon thanh: ")
(setq
ss (ssget '((0 . "LINE")))
lstThanh nil
)
(sudung prone ss)
(princ "\nSo luong cac thanh:")
(foreach pp lstThanh
(princ (strcat "\nThanh dai " (rtos (car pp)) ": " (itoa (cadr pp))))
)
(princ)
)
<a href="http://www.cadviet.com/upfiles/TKTD.lsp" target="_blank">http://www.cadviet.com/upfiles/TKTD.lsp</a>
Mong bác Jin hướng dẫn chi tiết cách sử dụng list với. tôi down về khi đánh lệnh TKTD nó bắt chọn đối tượng nhưng sau đó thực hiện như thế nào thì tôi chịu chết. MOng bác chỉ bảo cho.
<<
|
Filename: 184910_tktd.lsp
|
|
Tác giả: lp_hai
Bài viết gốc: 168971
Tên lệnh: ssdd |
Lisp cộng trừ text độ, phút, giây...
VD: 180O00'00" - 123o00'00" = kết quả
180-00-00 - 123-00-00 = kết...
>>
VD: 180O00'00" - 123o00'00" = kết quả
180-00-00 - 123-00-00 = kết quả
180,00,00 - 123,00,00 = kết quả
..... chỉ cần chọn text này rùi chọn - or + text khác ra kết quả đúng là ok
Bạn test thử nhá!
Mình ghi ra kết quả theo: 180o12'34"
(defun c:ssdd(/ t1 t2 ls1 ls2 pt1 nd1 nd2 l1 l2 d1 d2 p1 p2 s1 s2 ts tp td th olay font lay tong cao)
(setq t1 (entsel "\nChon text 1: ")
t2 (entsel "\nChon text 2: ")
ls1 (entget (car t1))
ls2 (entget (car t2))
pt1 (getpoint "\nChon diem dat ket qua: ")
nd1 (cdr (assoc 1 ls1))
l1 (strlen nd1)
nd2 (cdr(assoc 1 ls2))
l2 (strlen nd2)
d1 (substr nd1 1 (- l1 7))
p1 (substr nd1 (- l1 5) 2)
s1 (substr nd1 (- l1 2) 2)
d2 (substr nd2 1 (- l2 7))
p2 (substr nd2 (- l2 5) 2)
s2 (substr nd2 (- l2 2) 2)
ts (+ (atoi s1) (atoi s2))
tp (+ (atoi p1) (atoi p2))
td (+ (atoi d1) (atoi d2))
)
(if (>= ts 60)
(setq tp (+ tp 1)
ts (- ts 60)
)
)
(if (>= tp 60)
(setq td (+ td 1)
tp (- tp 60)
)
)
(cond ((and (< ts 10) (< tp 10))
(setq tong (strcat (rtos td) "o0" (rtos tp) "'0" (rtos ts) "\""))
)
)
(cond ((and (< ts 10) (>= tp 10))
(setq tong (strcat (rtos td) "o" (rtos tp) "'0" (rtos ts) "\""))
)
)
(cond ((and (>= ts 10) (< tp 10))
(setq tong (strcat (rtos td) "o0" (rtos tp) "'" (rtos ts) "\""))
)
)
(cond ((and (>= ts 10) (>= tp 10))
(setq tong (strcat (rtos td) "o" (rtos tp) "'" (rtos ts) "\""))
)
)
(setq th (getvar "textsize"))
(setq olay (getvar "clayer"))
(setq cao (cdr(assoc 40 ls1)))
(setq font (cdr(assoc 7 ls1)))
(setq lay (cdr(assoc 8 ls1)))
(setvar "clayer" lay)
(command "text" "s" font "m" pt1 cao "0" tong "")
(setvar "textsize" th)
(setvar "clayer" olay)
(princ)
)
<<
|
Filename: 168971_ssdd.lsp
|
|
Tác giả: npham
Bài viết gốc: 169122
Tên lệnh: demo |
Lisp cộng trừ text độ, phút, giây...
Ý định của mình là đưa ra đoạn code tham khảo, sau đó bạn có thể chỉnh sửa theo ý mình.
Mình làm lại cái theo đề nghị của bạn:
- Nhập tóan tử (+/-), mặc định là lần nhập trước nếu bỏ qua.
- Nhập text 1
- Nhập text 2
- Nhập điểm chèn kết quả
- Quay lại nhập text1 ... cho đến khi bỏ qua 1 bước nào đó.
à quên, cái này xuất ra ...
>>
Ý định của mình là đưa ra đoạn code tham khảo, sau đó bạn có thể chỉnh sửa theo ý mình.
Mình làm lại cái theo đề nghị của bạn:
- Nhập tóan tử (+/-), mặc định là lần nhập trước nếu bỏ qua.
- Nhập text 1
- Nhập text 2
- Nhập điểm chèn kết quả
- Quay lại nhập text1 ... cho đến khi bỏ qua 1 bước nào đó.
à quên, cái này xuất ra dạng 00d00'00", nếu yêu cầu phải đúng định dạng như đầu vào thì phải thêm 1 đoạn nữa. Bác thấy có nhất thiết phải thế không?
(defun c:demo (/ e e1 e2 key)
(defun s2d (str / ret)
(setq ret
(vl-list->string
(vl-remove-if
'(lambda (x) (or (< x 48) (> x 57)))
(reverse (vl-string->list str))
)
)
)
(angtof
(vl-list->string
(reverse
(vl-string->list
(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
)
)
)
)
)
(if (not func) (setq func + #func " + "))
(setq key (getstring (strcat "\nEnter an option <" #func">: ")))
(cond
((member key '("-" "_")) (setq #func " - ") (setq func -))
((member key '("+" "=")) (setq #func " + ")(setq func +))
)
(while
(and func
(setq e1 (car (entsel "\nChon text 1 <Exit>:?")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nChon text 2 <Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nDiem chen ket qua <exit>:"))
)
(setq e (subst (cons 10 p) (assoc 10 e) e))
(setq e (subst (cons 1 (angtos (func e1 e2) 1 4)) (assoc 1 e) e))
(entmake e)
)
)
<<
|
Filename: 169122_demo.lsp
|
|
Tác giả: Doan Van Ha
Bài viết gốc: 169659
Tên lệnh: ca |
Lisp kết hợp lệnh Array và Copy
@DVH Đề của em là ntn. Anh giúp giùm em nha>>
Tôi viết cho bạn và cho ai cần dùng với trường hợp khá tổng quát: đối tượng không phải *text thì copy-array bình thường, đối tượng là *text thì copy-array tăng lên 1 đơn vị.
Các chú ý khi dùng:
- Chỉ 1 *text được tăng dần.
- *Text có thể là số bất kỳ (int, real), có thể có tiền tố, hậu tố.
- Code hơi dài vì xét cả tiền tố rồi hậu tố, mệt nhất là số dạng real. Bạn thông cảm nhé.
Thân thương!
; Doan Van Ha CADViet.com
; Copy-Array cac doi tuong, rieng *Text co chua so thi tang dan 1 don vi, chap nhan so co tien to va hau to (chi xet 1 *Text).
(defun C:CA (/ dsdt dt dt1 dt2 p1 p2 sl x kwrd strt strp num sym)
(command "undo" "be")
(princ "\nChon cac doi tuong can Copy-Array...")
(setq dsdt (acet-ss-to-list (setq dt (ssget)))
dt1 dt
p1 (getpoint "\nDiem goc: ")
p2 (getpoint p1 "\nDiem den: ")
sl (getint "\nSo lan: ")
x 1)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(foreach n dsdt
(if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
(setq dt1 (ssdel n dt) dt2 n)))
(if dt2
(progn
(initget "Y N")
(setq kwrd (getkword "\nBan muon Text tang dan ? "))
(setq x 1)
(repeat (1- sl)
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(if (eq kwrd "Y")
(progn
(CHIA (cdr (assoc 1 (entget dt2))))
(entmod (subst (cons 1 (strcat strt (rtos (+ (atof num) x) 2 daup) strp)) (assoc 1 (entget (entlast))) (entget (entlast))))
(entupd (entlast))))
(setq x (1+ x)))))
(setq x 1)
(repeat (1- sl)
(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(setq x (1+ x)))
(command "undo" "e")
(acet-sysvar-restore)
(princ))
;----- Chia text lam 3 phan: tien to, num, hau to.
(defun CHIA(str / strtp)
(setq strt (PHAN str)
strp (DAO (PHAN (DAO str)))
num (ACET-STR-LR-TRIM strt (ACET-STR-LR-TRIM strp str))
daup (if (not (ACET-STR-FIND "." num)) 0 (strlen (substr num (+ 1 (strlen ".") (strlen (substr num 1 (- (ACET-STR-FIND "." num) 1)))))))))
;----- Lay 1 phan ben phai hoac trai cua num.
(defun PHAN(str / str1)
(setq str1 str num nil)
(while (and (not num) (/= str1 ""))
(if (distof (substr str1 1 1))
(setq strtp (substr str 1 (- (ACET-STR-FIND (substr str1 1 1) str) 1))
str1 "")
(setq str1 (substr str1 2))))
strtp)
;----- Dao nguoc 1 chuoi.
(defun DAO(str / str2)
(setq str2 str strn "")
(while (/= "" str2)
(setq strn (strcat (substr str2 1 1) strn))
(setq str2 (substr str2 2 (strlen str2))))
strn)
<<
|
Tác giả: cuongtk2
Bài viết gốc: 462735
Tên lệnh: test |
Nhờ các bác viết giúp mình list lọc text
Xem cái này
(defun c:test ( / SS STR)
(setq str (getstring "\Ky tu nhap vao"))
(if (null str) (exit))
(setq str (strcat "*" str "*"))
(setq ss (ssget (list
(cons 0 "*TEXT")
(cons -4 "<OR")
(cons 1 str)
(cons 1 (strcase str))
(cons -4 ">>
Xem cái này
(defun c:test ( / SS STR)
(setq str (getstring "\Ky tu nhap vao"))
(if (null str) (exit))
(setq str (strcat "*" str "*"))
(setq ss (ssget (list
(cons 0 "*TEXT")
(cons -4 "<OR")
(cons 1 str)
(cons 1 (strcase str))
(cons -4 "OR>")
)
)
)
(command "copy" ss "" pause )
)
<<
|
Filename: 462735_test.lsp
|
|
Tác giả: huunhantvxdts
Bài viết gốc: 462746
Tên lệnh: tkte |
Xin lisp thông kê đối tượng Text
17 giờ trước, emhoccad đã nói:
17 giờ trước, emhoccad đã nói:
Chào các bác,
E cần lisp thống kê danh sách các Text trong bản vẽ thành 1 danh sách như bảng dưới.
Ví dụ: N1,N2,N3,vv...
Cảm ơn các bác^^
thong ke text.dwg
Gửi bạn!!!!
(defun C:TKTE(/ acdoc acspc lsttthe lsttk nd lstin point point2 p1 p2 pointt cur_lay oldos)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "UNDO" "Be")
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace)))
(prompt "\nChon TEXT thong ke")
(setq lsttthe (ST:SS->List-Vla (ssget '((0 . "TEXT")))))
(setq lsttk nil)
(foreach ent lsttthe
;(setq ent (vlax-ename->vla-object (car (entsel))))
(setq nd (vlax-get-property ent 'TextString))
(setq lsttk (append (list nd) lsttk))
)
(setq lstin (LM:CountItems lsttk))
(setq lstin (vl-sort lstin '(lambda (x y) (< (car x) (car y)))))
(setq point (getpoint "/nPick diem dat"))
(setq point2 (polar point 0 1.38))
(command "Line" point point2 "")
(foreach ent lstin
(setq p1 (polar point (/ pi -2) 0.36))
(setq p2 (polar point2 (/ pi -2) 0.36))
(command "Line" p1 p2 "")
(command "Line" point p1 "")
(command "Line" point2 p2 "")
(command "Line" (polar point 0 (/ 1.38 2)) (polar p1 0 (/ 1.38 2)) "")
(setq pointt (polar (polar p1 0 0.1247) (/ pi 2) 0.0745))
(vla-addtext acspc (car ent) (vlax-3d-point pointt) 0.18)
(setq pointt (polar pointt 0 0.8305))
(vla-addtext acspc (cdr ent) (vlax-3d-point pointt) 0.18)
(setq point p1)
(setq point2 p2)
)
;;;;;;;;;;;;;;;;;;;;
(command "UNDO" "End")
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(princ)
)
(defun LM:CountItems ( l / c l r x )
(while l
(setq x (car l)
c (length l)
l (vl-remove x (cdr l))
r (cons (cons x (- c (length l))) r)
)
)
(reverse r)
)
(defun CV:ss-to-list (ss vla / n e l)
(if ss
(progn
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (if vla (vlax-ename->vla-object e) e) l))
)
)
)
)
<<
|
Filename: 462746_tkte.lsp
|
|
Tác giả: ketxu
Bài viết gốc: 172220
Tên lệnh: dc |
viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo
Viết cho anh em xài. Lisp chấp nhận cả Cos cao độ dạng Text hoặc ATT, và tất nhiên lấy text đầu - ATT đầu của Block đầu xử lý
-Update DImzin ^^
(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(defun dowith(lstSS / lstSS en str)
(cond ((setq en (car (vl-remove-if-not...
>>
Viết cho anh em xài. Lisp chấp nhận cả Cos cao độ dạng Text hoặc ATT, và tất nhiên lấy text đầu - ATT đầu của Block đầu xử lý
-Update DImzin ^^
(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(defun dowith(lstSS / lstSS en str)
(cond ((setq en (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
(setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
)
)
(cons en str)
)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq lstSS (acet-ss-to-list (setq ss (ssget)))
obj (car (setq en (dowith lstSS)))
str (cdr en)
p1 (getpoint "\nBasepoint :")
eL (entlast)
oDz (getvar "Dimzin")
)
(setvar "DIMZIN" 0)
(while (setq p2 (getpoint p1 "\nTo point :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq Txt1 (car (dowith listName))
eL (entlast)
)
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) "%%p")
(T "")
)
(rtos num 2 3))
)
)
(setvar "DIMZIN" oDZ)
)
<<
|
Tác giả: thanhduan2407
Bài viết gốc: 462811
Tên lệnh: za | |
Tác giả: cuongtk2
Bài viết gốc: 462824
Tên lệnh: test |
Nhờ viết Lisp di chuyển các Block thuộc tính
Cơ bản như thế này
(defun c:test ( / D E I N OBJ PT SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
(cadr (acet-dxf 10 (entget e2)))
)) )
(setq pt (getpoint "\nVi tri moi")
d (getdist "\nKhoang dan dong" pt))
(while (< i n)
...
>>
Cơ bản như thế này
(defun c:test ( / D E I N OBJ PT SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
(cadr (acet-dxf 10 (entget e2)))
)) )
(setq pt (getpoint "\nVi tri moi")
d (getdist "\nKhoang dan dong" pt))
(while (< i n)
(progn
(setq e (nth i ss)
obj (vlax-ename->vla-object e))
(vla-put-InsertionPoint obj (vlax-3d-point(polar pt (* pi 1.5) (* d i))))
)
(setq i (1+ i))
)
(princ)
)
<<
|
Filename: 462824_test.lsp
|
|
Tác giả: cuongtk2
Bài viết gốc: 462831
Tên lệnh: test |
Nhờ viết Lisp di chuyển các Block thuộc tính
Thật xin lỗi vì đã không mở bản vẽ ra xem. Cái này đã sửa lại rồi nha.
(defun c:test ( / D E I N OBJ PT SS INS P0 X X1 Y Y1)
;; prp - Dynamic Block property name (case-insensitive)
;; val - New value for property
;; Returns: New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
(setq prp (strcase prp))
(vl-some
'(lambda ( x )
(if...
>>
Thật xin lỗi vì đã không mở bản vẽ ra xem. Cái này đã sửa lại rồi nha.
(defun c:test ( / D E I N OBJ PT SS INS P0 X X1 Y Y1)
;; prp - Dynamic Block property name (case-insensitive)
;; val - New value for property
;; Returns: New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
(setq prp (strcase prp))
(vl-some
'(lambda ( x )
(if (= prp (strcase (vla-get-propertyname x)))
(progn
(vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
(cond (val) (t))
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
(cadr (acet-dxf 10 (entget e2)))
)) )
(setq pt (getpoint "\nVi tri moi")
d (getdist "\nKhoang dan dong" pt))
(while (< i n)
(progn
(setq e (nth i ss)
obj (vlax-ename->vla-object e)
p0 (acet-dxf 10 (entget e))
x1 (car p0) y1 (cadr p0)
ins (polar pt (* pi 1.5) (* d i))
x (car ins) y (cadr ins))
(LM:setdynpropvalue obj "Position X" (- x x1))
(LM:setdynpropvalue obj "Position Y" (- y y1))
)
(setq i (1+ i))
)
(princ)
)
<<
|
Filename: 462831_test.lsp
|
|
Tác giả: ketxu
Bài viết gốc: 171011
Tên lệnh: test |
Đổi tên của layout
Với yêu cầu làm hàng loạt thì tốt nhất là hỏi thăm anh Lisp ^^
Ví dụ :
(defun C:test (/ item *doc* after)
;Ketxu
(vl-load-com)
(setq after (getstring "\nHau to can them vao :")
*doc* (vla-get-layouts(vla-get-activedocument (vlax-get-acad-object))))
(foreach lay(layoutlist)
(vla-put-name (setq item (vla-item *doc* lay)) (strcat (vla-get-name item) after))
)
(princ)
)
|
Filename: 171011_test.lsp
|
|
Tác giả: Tue_NV
Bài viết gốc: 88805
Tên lệnh: bat tat |
đặt phím tắt cho lệnh Ortho
Thanks anh em. Mình mới bắt đầu học nên tò mò về Cad ! Khi nào bạn NgoVinh viết Lisp thi gửi cho mình 1 bản nhé !
Nếu bạn muốn sử dụng Lisp thì đây...
>>
Thanks anh em. Mình mới bắt đầu học nên tò mò về Cad ! Khi nào bạn NgoVinh viết Lisp thi gửi cho mình 1 bản nhé !
Nếu bạn muốn sử dụng Lisp thì đây :
Tên lệnh là Bat -> Bật ORTHO
Tên lệnh là Tat -> Tắt ORTHO
(defun c:Bat()
(command "ORTHO" "ON") (princ)
)
(defun c:Tat()
(command "ORTHO" "OFF") (princ)
)
<<
|
Filename: 88805_bat_tat.lsp
|
|
Tác giả: duy782006
Bài viết gốc: 172109
Tên lệnh: 1 |
lisp chuyển layer
Ví dụ thế này:
Mình muốn chuyển 1 đối tượng từ layer "0" sang layer "net lien". Thông thường là chọn đối tượng >>>...
>>
Ví dụ thế này:
Mình muốn chuyển 1 đối tượng từ layer "0" sang layer "net lien". Thông thường là chọn đối tượng >>> qua Properties >>> đổi layer của đối tượng sang "nét liền" (hoặc dùng lệnh MA). Mình muốn thao tác ngắn gọn chỉ là: Chọn đt >>> lệnh (ví dụ là "1" chẳng hạn) >>> Enter >>> đối tượng chuyển sang layer "net lien".
Chỉ có thế bạn ạ!
Mong ban giúp! mình tìm mãi mà không thấy lisp giải quyết!
Thanks!!!!!
(Defun c:1 ( )
(Prompt "\nChon doi tuong muon chuyen lop...")
(Setq chuyen (Ssget))
(command "chprop" chuyen "" "la" "netlien" "")
(Princ)
)
<<
|
Tác giả: shitty
Bài viết gốc: 130116
Tên lệnh: h2 |
Viết lisp theo yêu cầu [phần 2]
Lỗi này do máy bạn chưa cài bộ Express Tool.Bạn cài lại nó vào đi :)
Nếu khó khăn trong việc cài bộ Express thì bạn dùng lại đoạn...
>>
Lỗi này do máy bạn chưa cài bộ Express Tool.Bạn cài lại nó vào đi :)
Nếu khó khăn trong việc cài bộ Express thì bạn dùng lại đoạn sau cho nó thuần :
;free lisp from cadviet.com @ ketxu
(defun c:h2()
(setq vList '("hpname" "hpscale" "hpang" "hpassoc" "hpgaptol" "clayer" "HPSEPARATE") ; Sys Var list
vValue (mapcar 'getvar vList))
(initget 1 "0 WALL W GRASS GR GROUND G MARBLE M WC S SAND B BRICK")
(setq s1 (getkword "\n0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK "))
(cond
((= "0" (strcase s1)) (SetHvar "ansi37" 1 0 1 20 ))
((= "WC" (strcase s1)) (SetHvar "ansi31" 1 0 1 20))
((or (= "GR" (strcase s1)) (= "GRASS" (strcase s1)))(SetHvar "GRASS" 1 0 1 20))
((or (= "S" (strcase s1)) (= "SAND" (strcase s1)))(SetHvar "AR-CONC" 1 0 1 20))
((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
((or (= "M" (strcase s1)) (= "MARBLE" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
((or (= "B" (strcase s1)) (= "BRICK" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
((or (= "W" (strcase s1)) (= "WALL" (strcase s1)))(SetHvar "AR-CONC" 1 0 1 20))
);end cond
(command "-hatch")
(while (< 0 (getvar "CMDACTIVE")) (command pause))
(mapcar 'setvar vList vValue)
);END C:
(defun SetHvar (hName hScale hAng hAssoc hGap) ;hLayer)
(mapcar 'setvar vlist (list hname hScale hAng hAssoc hgap "00-08Hatch" 1))
)
e cài xong cái express tool thì dùng dc nhưng khi tắt cad bật lại thi lisp lai ba'o lỗi :
0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK w
; error: no function definition: SETHVAR
<<
|
Tác giả: ketxu
Bài viết gốc: 169505
Tên lệnh: dar |
Dynamic LArray
@matden : Mình đã nói là chưa phân biệt được chữ cái với text số mà :)
phòng 1 -> phòng 2 -> phòng 3 .... nó lại là một chuyện khác, và nó cần nhiều hơn vài đoạn code như ket đã giới thiệu :) Hơn nữa, giả sử, mình làm xong rồi, hôm sau lại có bạn hỏi 1 người -> 2 người -> 3 người.... hôm sau nữa lại có người hỏi Phòng ngủ A -> phòng ngủ B.....=> vậy phải làm sao...
>>
@matden : Mình đã nói là chưa phân biệt được chữ cái với text số mà :)
phòng 1 -> phòng 2 -> phòng 3 .... nó lại là một chuyện khác, và nó cần nhiều hơn vài đoạn code như ket đã giới thiệu :) Hơn nữa, giả sử, mình làm xong rồi, hôm sau lại có bạn hỏi 1 người -> 2 người -> 3 người.... hôm sau nữa lại có người hỏi Phòng ngủ A -> phòng ngủ B.....=> vậy phải làm sao ????
Để thực hiện việc này tốt nhất bạn sử dụng riêng biệt các lisp copy text, hoặc đừng copy tăng nữa, sử dụng lisp này xong thì dùng Tcount
P/s : nếu không muốn mouse nhảy, tức là không muốn sử dụng Undo, vậy chỉ còn cách xóa tập vừa tạo. Lưu ý với matden là cách này trong nhiều trường hợp khá nguy hiểm, nên mình post riêng cho bạn 1 bản như vậy :
(vl-load-com)
(defun c:dar( / dir gr nx p0 px pxv ssFull ss1 vecx ans inc)
(grtext -1 "Dynamic LArray @Ketxu")
(setq m:err *error* *error* err)
(command "undo" "be")
(if (setq ssFull (ST:SS->List-Vla (ssget))
p0 (getpoint "\n\U+0110i\U+1EC3m g\U+1ED1c ::")
px (getpoint p0 "\nH\U+01B0\U+1EDBng v\U+00E0 kho\U+1EA3ng c\U+00E1ch copy :")
vecx (mapcar '- px p0)
)
(progn
(cond ((ST:Check-Exist '("AcDbText" "AcDbMText") (mapcar 'vla-get-objectname ssFull))
(setq ans (strcase(getstring "Copy t\U+0103ng Text ? < K > :")))
(cond ((not (or (= ans "K")(= ans "")))
(or #num (setq #num 1))
(setq #num (cond ((getint (strcat "\nGia s\U+1ED1 < " (rtos #num 2 0) " > :")))(#num)) inc T)
)
)
)
)
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
(while (= (car (setq gr (grread nil 5 0))) 5)
(if ss1 (ST:Ss-Delete ss1))
(redraw)
(setq pxv (mapcar '- (inters (cadr gr) (polar (cadr gr) (+ (/ pi 2.0) (angle px p0)) 1.0) p0 px nil) p0))
(if (< (setq nx (fix (/ (caddr (trans pxv 0 vecx)) (caddr (trans vecx 0 vecx))))) 0)
(setq dir -1 nx (- nx)) (setq dir 1))
(setq ss1 (ST:Ss-Copy-Dynamic ssFull nx vecx dir inc #num))
(grdraw p0 (mapcar '+ p0 pxv) 3 1)
)
)
)
(command "undo" "en")
(setq ss1 nil)
(princ)
)
(defun ST:Ss-Copy-Dynamic (sslst n v dir inc num / i matlist obj1 ss transmat xobj isText str isReal)
(setq ss (ssadd))
(foreach xobj sslst
(setq i 1)
(cond ((and (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(cond ((= 'REAL (type (read (setq str (vla-get-textstring xobj)))))
(setq j (atof str) isReal T))
(T (setq j (atoi str) isReal nil))
)
(setq isText T)
)
(T setq isText nil)
)
(repeat n
(setq obj1 (vla-copy xobj)
matList (list (list 1 0 0 (* i (car v) dir)) (list 0 1 0 (* i (cadr v) dir)) '(0 0 1 0) '(0 0 0 1))
transmat (vlax-tmatrix matlist))
(vla-transformby obj1 transMat)
(if (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(vla-put-textstring obj1 (rtos (setq j (+ num j)) 2 (if isReal 1 0))))
(ssadd (vlax-vla-object->ename obj1) ss)
(setq i (1+ i))
)
)
ss
)
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun ST:Ss-Delete (ss / i)
(mapcar 'vla-delete (ST:SS->List-Vla ss))
)
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1)))) ;from topic Dovui ^^
(defun err (msg)
(if ss1 (ST:Ss-Delete ss1))
(setq *error* m:err
m:err nil
)
)
<<
|
Tác giả: ketxu
Bài viết gốc: 169895
Tên lệnh: par |
Dynamic Polar Array
Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người xài chơi.
Cho phép tăng dần đối với Text (như bản Dynamic Larray)
Mời mọi người dùng thư giãn và thanks nhé ^^ hệch hệch
Preview :
Open Source...
>>
Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người xài chơi.
Cho phép tăng dần đối với Text (như bản Dynamic Larray)
Mời mọi người dùng thư giãn và thanks nhé ^^ hệch hệch
Preview :
Open Source :
;Polar Array @Ketxu 22-9
;CADViet.com
;Many thank to qjchen again
(vl-load-com)
(defun c:par( / ang angnow gr oang p0 px px1 ss ss1 cc oldAng ans)
(grtext -1 "Dynamic PArray @Ketxu")
(setq m:err *error* *error* err)
(command "undo" "be")
(setq oldAng (getvar "angbase"))
(if (and
(setq ss (ST:SS->List-Vla (ssget))
p0 (getpoint "\nT\U+00E2m quay : :")
px (getpoint p0 "\n\U+0110\U+01B0\U+1EDDng c\U+01A1 s\U+1EDF ::")
)
)
(progn
(grdraw p0 px 1)
(setvar "angbase" (angle p0 px))
(setq cc (_circle p0 (distance p0 px))
ang (getangle p0 "\nG\U+00F3c Array :")
s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE")))
)
(cond ((ST:Check-Exist '("AcDbText" "AcDbMText") (mapcar 'vla-get-objectname ss))
(setq ans (strcase(getstring "Copy t\U+0103ng Text ? < K > :")))
(cond ((not (or (= ans "K")(= ans "")))
(or #num (setq #num 1))
(setq #num (cond ((getint (strcat "\nGia s\U+1ED1 < " (rtos #num 2 0) " > :")))(#num)) inc T)
)
)
)
)
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
(while (= (car (setq gr (grread nil 5 0))) 5)
(if ss1 (mapcar 'vla-delete ss1))
(redraw)
(setq angnow (angle p0 (cadr gr))
g (trans (cadr gr) 1 3)
)
(grvecs (LM:GrText (rtos (/ (* angnow 180) pi) 2 0) 3)
(
(lambda ( r x y )
(list
(list r 0. 0. x )
(list 0. r 0. y )
(list 0. 0. r 0.)
(list 0. 0. 0. 1.)
)
)
s
(+ (car g) (* 15 s))
(- (cadr g) (* 31 s))
)
)
(if (and (< ang 0)(> angnow 0)) (setq angnow (- angnow (* 2 pi))))
(if (and (> ang 0)(< angnow 0)) (setq angnow (+ (* 2 pi) angnow)))
(setq ss1 (_copyCC ss (fix (/ angnow ang)) p0 ang inc #num))
(grdraw:arc p0 (/ (getvar "viewsize") 4.0) (angle p0 px) angnow)
)
(entdel cc)
;(setvar "angbase" oldAng)
)
)
(command "undo" "en")
(princ)
)
;;; =======================================================================;
;;; by qjchen, copy ss according to the direction and vector ;
;;; =======================================================================;
(defun _copyCC (sslst n cen ang inc num / i obj1 ss xobj lst number)
(foreach xobj sslst
(setq i 1)
(cond ((and (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(cond ((= 'REAL (type (setq number (last (setq lst (ST:String-GetNumber (vla-get-textstring xobj)))))))
(setq isReal T))
(T (setq isReal nil))
)
(setq isText T)
) ;Text Object
(T setq isText nil)
)
(repeat n
(setq obj1 (vla-copy xobj))
(Vla-rotate obj1 (vlax-3d-point cen) (* ang i))
(if (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(vla-put-textstring obj1 (strcat (car lst) (rtos (setq number (+ num number)) 2 (if isReal 1 0))(cadr lst))))
(setq i (1+ i) ss (cons obj1 ss))
)
)
ss
)
;;; =======================================================================;
;;; @Ketxu Make Circle Temp ;
;;; =======================================================================;
(defun _circle (p0 r / ent)
(redraw (setq ent(entmakex (list (cons 0 "CIRCLE")(cons 10 (trans p0 1 0))(cons 40 r)))) 3) ent)
(defun RtD (rad) ; converts radian to degree
(/ (* rad 180) pi)
);defun
;;; =======================================================================;
;;; Check List Item Exist in Other List @Ketxu ;
;;; =======================================================================;
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1))))
;;; =======================================================================;
;;; Selection to list VLA @Ketxu ;
;;; =======================================================================;
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun ST:Ss-Delete (ss / i)
(mapcar 'vla-delete (ST:SS->List-Vla ss))
)
;;; =======================================================================;
;;; grdraw circle arc ;
;;; =======================================================================;
(defun grdraw:arc(cen r ang angadd / angdiv n)
(grdraw cen (polar cen ang r) 3 1)
(grdraw cen (polar cen (+ ang angadd) r) 3 1)
(setq n 100 angdiv (/ angadd n))
(repeat n
(grdraw (polar cen ang r)(polar cen (setq ang (+ ang angdiv)) r) 1 1)
)
)
(defun ST:String-GetNumber (str / i j dau cuoi tmp tmp1 tmp2 num)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(if (vl-string-search "." (setq num (vl-string-left-trim tmp1 (vl-string-right-trim tmp2 str)))) (atof num) (atoi num))
)
)
;;; =======================================================================;
;;; Error del selection @Ketxu ;
;;; =======================================================================;
(defun err (msg)
(if ss1 (mapcar 'vla-delete ss1))
(if cc (entdel cc))
(if oldAng (setvar "angbase" oldAng))
(setq *error* m:err m:err nil)
)
(defun LM:GrText ( str col / c i l v y ) ;@Lee Mac
(setq v
'(
(" ")
("\t")
("!" 45 45 65 135)
("\"" 104 134 107 137)
("#" 43 63 46 66 84 94 87 97 115 135 118 138 72 78 103 109)
("$" 25 35 52 52 43 47 58 78 83 87 92 112 123 127 118 118 135 135)
("%" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129 47 48 67 68 56 56 59 59 113 114 133 134 122 122 125 125)
("&" 43 46 49 49 52 72 57 58 67 68 76 76 79 79 83 83 85 85 94 94 103 123 134 136 127 127)
("'" 105 135)
("(" 17 17 26 36 45 105 116 126 137 137)
(")" 14 14 25 35 46 106 115 125 134 134)
("*" 73 74 76 77 84 86 92 98 104 106 113 114 116 117)
("+" 55 115 82 84 86 88)
("," 34 35 45 46 55 57)
("-" 83 88)
("." 45 46 55 56)
("/" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129)
("0" 44 47 134 137 53 123 58 128)
("1" 44 48 124 125 56 136)
("2" 43 48 53 53 64 64 75 75 86 86 97 97 108 128 134 137 123 123)
("3" 53 53 44 47 58 88 95 97 108 128 134 137 123 123)
("4" 46 48 57 137 78 78 73 76 83 83 94 94 105 115 126 126)
("5" 53 53 44 47 58 88 94 97 93 133 134 138)
("6" 44 47 58 88 95 97 84 84 53 113 124 124 135 137)
("7" 44 54 65 75 86 96 107 117 128 138 133 137 123 123)
("8" 44 47 94 97 134 137 53 83 58 88 103 123 108 128)
("9" 44 46 57 57 68 128 97 97 84 86 134 137 93 123)
(":" 45 46 55 56 95 96 105 106)
(";" 34 35 45 46 55 57 95 96 105 106)
("<" 47 47 56 56 65 65 74 74 83 83 94 94 105 105 116 116 127 127)
("=" 73 78 93 98)
(">" 43 43 54 54 65 65 76 76 87 87 96 96 105 105 114 114 123 123)
("?" 45 45 65 75 86 86 97 97 108 128 134 137 123 123)
("@" 34 38 43 43 52 112 123 123 134 137 128 128 79 119 68 68 65 66 105 106 77 107 74 94)
("A" 41 43 47 49 52 62 58 68 73 77 83 93 87 97 104 114 106 116 125 135 133 134)
("B" 42 47 53 123 58 88 108 128 94 97 132 137)
("C" 44 47 53 53 58 58 62 112 123 123 134 136 127 127 108 138)
("D" 42 46 57 57 127 127 132 136 68 118 53 123)
("E" 42 48 58 58 94 95 86 106 132 137 128 138 53 123)
("F" 42 45 94 95 86 106 132 137 128 138 53 123)
("G" 44 47 53 53 58 78 86 89 62 112 123 123 134 136 127 127 108 138)
("H" 41 43 47 49 131 133 137 139 93 97 52 122 58 128)
("I" 43 47 133 137 55 125)
("J" 52 62 43 46 57 127 135 139)
("K" 42 44 48 49 132 134 136 138 53 123 84 85 95 95 106 116 127 127 76 76 67 67 58 58)
("L" 42 47 48 58 53 123 132 135)
("M" 41 43 47 49 52 122 58 128 131 132 138 139 103 113 107 117 84 94 86 96 65 75)
("N" 41 44 131 132 136 139 52 122 48 128 113 113 94 104 85 85 66 76 57 57)
("O" 44 46 53 53 57 57 123 123 127 127 134 136 62 112 68 118)
("P" 42 45 84 87 132 137 53 123 98 128)
("Q" 134 136 123 123 127 127 112 62 118 68 53 53 57 57 44 46 35 36 23 24 27 28)
("R" 42 44 48 49 132 137 123 53 128 98 84 87 76 76 67 67 58 58)
("S" 42 62 53 53 44 47 58 78 86 87 93 95 102 122 133 136 127 127 118 138)
("T" 43 47 55 125 132 138 131 121 139 129)
("U" 44 46 52 53 57 58 62 122 68 128 131 133 137 139)
("V" 45 55 64 74 66 76 83 103 87 107 112 122 118 128 131 133 137 139)
("W" 43 63 47 67 72 92 74 94 76 96 78 98 101 121 105 115 109 129 131 132 138 139)
("X" 41 43 47 49 131 133 137 139 52 52 58 58 63 63 67 67 74 74 76 76 85 95 104 104 106 106 113 113 117 117 122 122 128 128)
("Y" 43 47 55 85 94 94 96 96 103 113 107 117 122 122 128 128 131 133 137 139)
("Z" 122 122 58 58 132 138 42 48 128 128 52 52 63 63 74 74 85 95 106 106 117 117)
("" 14 16 134 136 26 126)
("^" 102 102 113 113 124 124 135 135 126 126 117 117 108 108)
("_" 21 29)
("`" 125 125 134 134)
("a" 43 46 48 48 52 72 57 97 83 86 103 106)
("b" 42 43 45 46 54 54 57 58 68 98 97 97 105 106 94 94 132 132 53 133)
("c" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 108 108)
("d" 44 45 47 48 52 92 53 53 56 56 93 93 104 105 96 96 136 136 57 137)
("e" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 88 88 73 78)
("f" 43 46 54 124 93 93 95 96 135 137 128 128)
("g" 13 16 22 32 27 97 107 108 66 66 96 96 54 55 104 105 63 63 93 93 62 92)
("h" 42 44 46 48 57 97 53 133 132 132 94 94 105 106)
("i" 43 47 55 105 103 104 135 135)
("j" 22 22 13 15 26 106 104 105 136 136)
("k" 42 44 46 48 53 133 132 132 57 57 66 66 74 75 85 85 96 106 107 108)
("l" 43 47 55 135 133 134)
("m" 41 43 45 46 48 49 52 102 55 105 58 108 101 101 93 93 104 104 96 96 107 107)
("n" 42 44 46 48 53 103 57 97 102 102 94 94 105 106)
("o" 44 46 104 106 53 53 57 57 93 93 97 97 52 92 58 98)
("p" 12 15 23 103 102 102 54 54 94 94 45 46 105 106 57 58 97 98 68 88)
("q" 15 18 27 107 108 108 56 56 96 96 44 45 104 105 52 53 92 93 62 82)
("r" 42 46 54 104 102 103 95 95 106 108 99 99)
("s" 52 52 43 47 58 68 73 77 82 92 103 107 98 98)
("t" 45 47 58 58 54 124 102 103 105 107)
("u" 102 102 106 106 53 103 56 56 44 45 47 107 48 48)
("v" 45 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("w" 43 53 47 57 62 92 64 84 66 86 68 98 101 103 95 105 107 109)
("x" 42 44 46 48 102 104 106 108 53 53 57 57 93 93 97 97 64 64 66 66 84 84 86 86 75 75)
("y" 12 13 24 24 35 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("z" 92 92 58 58 102 108 42 48 97 97 86 86 75 75 64 64 53 53)
("{" 16 17 25 65 73 74 85 125 136 137)
("|" 15 135)
("}" 14 15 26 66 77 78 86 126 134 135)
("~" 112 122 133 134 125 125 116 117 128 138)
)
)
(eval
(list 'defun 'LM:GrText '( str col / c i l v y )
(list 'setq 'v
(list 'quote
(mapcar
(function
(lambda ( b )
(cons (car B) (mapcar '(lambda ( a ) (if a (list (rem a 10) (/ a 10)))) (cdr B)))
)
)
v
)
)
)
'(setq i 0 y 0)
'(repeat (strlen str)
(cond
( (eq (setq c (substr str 1 1)) " ")
(setq i (+ i 9) str (substr str 2))
)
( (eq c "\t")
(setq i (+ i 36) str (substr str 2))
)
( (eq c "\n")
(setq i 0 y (- y 16) str (substr str 2))
)
( (setq l
(cons
(mapcar
(function
(lambda ( a )
(if a (list (+ (car a) i) (+ (cadr a) y)))
)
)
(cdr (assoc c v))
)
l
)
str (substr str 2) i (+ i 9)
)
)
)
)
'(cons col (apply 'append l))
)
)
(LM:GrText str col)
)
<<
|
Tác giả: ketxu
Bài viết gốc: 172034
Tên lệnh: tbkd |
lisp vẽ đường bóng ( đường thể hiện dốc trên mặt bằng )
vâng. Nói chung cũng chỉ cần tương đối thôi ạ ? Nhưng vấn đề phải đưa a vào bởi vì tùy thuộc mỗi bản vẽ mỗi khác và các...
>>
vâng. Nói chung cũng chỉ cần tương đối thôi ạ ? Nhưng vấn đề phải đưa a vào bởi vì tùy thuộc mỗi bản vẽ mỗi khác và các đường bóng xảy ra 2 trường hợp là hệ số k>1 và k< 1.
Mình đưa ra 1 ví dụ để bạn thấy việc viết lisp không đơn giản, và nếu người yêu cầu không biết mình cần gì, sẽ không bao giờ có đáp án, hoặc chí ít cũng không được như ý
(defun c:tbkd(/ eLine curve1 curve2 i j len1 len2 tmp)
(vl-load-com)
(or #dist (setq #dist 10)) ; 10 = Khoang cach mac dinh
(setq #dist (cond ((getdist (strcat "\nKhoang cach bat dau <" (vl-princ-to-string #dist) " > :")))(#dist)))
(or #inc (setq #inc 1.2)) ;
(setq #inc (cond ((getdist (strcat "\nGia so <" (vl-princ-to-string #inc) " > :")))(#inc)))
(defun eLine (p1 p2 / p2 col)(entmake (list (cons 0 "LINE")(cons 10 p1) (cons 11 p2)(cons 62 8) (cons 8 "0"))))
;;Doan duoi nay khong can de y
(If
(and
(setq curve1 (car(entsel "\nPath curve 1 :")))
(setq curve2 (car(entsel "\nPath curve 2 :")))
(wcmatch (cdadr (entget curve1)) "*LINE,ARC")
(wcmatch (cdadr (entget curve2)) "*LINE,ARC")
(eLine (vlax-curve-getStartPoint curve1) (vlax-curve-getStartPoint curve2))
(setq tmp 0 i 0 len1 (vlax-curve-getDistAtParam curve1 (vlax-curve-getEndParam curve1)) len2 (vlax-curve-getDistAtParam curve2 (vlax-curve-getEndParam curve2)))
)
(while (<= (setq tmp (+ (* #dist (expt #inc (setq i (1+ i))))tmp)) len1)
(eLine (vlax-curve-getPointAtDist curve1 tmp) (vlax-curve-getPointAtDist curve2 tmp))
)
)
)
<<
|
Filename: 172034_tbkd.lsp
|
|
Tác giả: Doan Van Ha
Bài viết gốc: 447639
Tên lệnh: test |
Nhờ sửa lisp với hàm IF
(Defun c:TEST()
(setq HIENHANH (getvar "clayer"))
(Prompt "\nSelect objects >>> DINHTT")
(Setq CHUYEN (Ssget))
(if (not (tblsearch "layer" "DINHTT"))
(COMMAND "-layer" "M" "DINHTT" "C" "1" "" "L" "CONTINUOUS" "" ""))
(command "chprop" CHUYEN "" "la" "DINHTT" "")
(setvar "clayer" HIENHANH)
(princ))
|
Filename: 447639_test.lsp
|
|