Jump to content
InfoFile
Tác giả: Thaistreetz
Bài viết gốc: 197609
Tên lệnh: wr
- Lệnh Bật/Tắt wipeout thay cho lệnh của cad

Trong các bản cad2013+ thì wipeout đã được tích hợp vào cad như 1 đối tượng chính thức của cad chứ không fải được tải vào thông qua 1 arx ngoài nữa. đối tượng wipeout cũng được thêm 1 trạng thái chỉ hiện chứ không in ra: "Display but not plot" so với các bản cad trước chỉ có 2 trạng thái On và Off

Việc điều khiển trạng thái của đối tương wipeout từ fiên bản này được...
>>
Trong các bản cad2013+ thì wipeout đã được tích hợp vào cad như 1 đối tượng chính thức của cad chứ không fải được tải vào thông qua 1 arx ngoài nữa. đối tượng wipeout cũng được thêm 1 trạng thái chỉ hiện chứ không in ra: "Display but not plot" so với các bản cad trước chỉ có 2 trạng thái On và Off

Việc điều khiển trạng thái của đối tương wipeout từ fiên bản này được chuyển cho 1 biến hệ thống là WIPEOUTFRAME chứ không dùng từ điển đối tượng nữa. các giá trị tương ứng:
- Off <0>
- On <1>
- Display but not plot <2>

Lisp trên được viết lại để tương thích cho cả các bản cad 2013+ như sau:

(defun c:wr (/ en)
(if (< (atof (getvar "acadver")) 19)
(if (not (setq en (dictsearch (namedobjdict) "ACAD_WIPEOUT_VARS")))
(prompt "<< Khong co doi tuong wipeout nao trong ban ve>>")
(progn
(if (= (cdr (assoc 70 en)) 0)
(progn (entmod-en 70 1 (cdr (assoc -1 en))) (prompt ": << Bat Wipeout >>"))
(progn (entmod-en 70 0 (cdr (assoc -1 en))) (prompt ": << Tat Wipeout >>")))
(foreach en (ss->list (ssget "x" '((0 . "WIPEOUT,INSERT")))) (entupd en))))
(if (= (getvar "wipeoutframe") 0)
(progn (setvar "wipeoutframe" 1) (prompt ": << Bat Wipeout >>"))
(progn (setvar "wipeoutframe" 0) (prompt ": << Tat Wipeout >>"))))
(princ))

<<

Filename: 197609_wr.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 197699
Tên lệnh: ha
Thêm dòng lệnh vào Lisp tính tổng chiều dài Line, Pline ???

Đây bạn: Lisp tính tổng chiều dài các đối tượng trong 1 curve kín.

@Ketxu: Chỉ biết cách vi phân curve thôi (như đã có trong lisp này). Và mức độ chính xác tuỳ thuộc khoảng cách vi phân. Không biết Ket có cách hay hơn không?
P/S: đã sửa lại highlight cho dễ nhìn hơn grip.

Filename: 197699_ha.lsp
Tác giả: dovananh.xd
Bài viết gốc: 197754
Tên lệnh: t2u
chuyển bảng mã từ TCVN3 sang UNICODE
Chính là cái lisp này nè anh:
http://www.cadviet.com/upfiles/3/89140_nghia_1.lsp

Filename: 197754_t2u.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 197631
Tên lệnh: tton
viết lisp tính chiều dài đường ống nước

Hề hề hề.
Do máy của minh đang bị trục trặc nên chưa thể giúp bạn ngay. Để tối nay mình sẽ làm thử bạn nhé. Hy vọng sẽ có bác khác giải quyết giúp bạn sớm hơn.

Hề hề hề,
Bạn thử dùng cái này xem đã đúng ý bạn chưa nhé. Nếu cần thay đổi gì thì hãy post lên:

Chúc bạn vui.

Filename: 197631_tton.lsp
Tác giả: bach1212
Bài viết gốc: 197760
Tên lệnh: tcal
LISP cộng têxt toàn bộ bản vẽ thêm 1 hằng sô
Thêm 1 chú nữa:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=37567
;;----------------------------------------------;;
;; Text calculation tool - Skywings ;;
;;----------------------------------------------;;
;;***SUB-FUNCTION***
(defun GET-TEXT ()
(princ "\nSelect NUMBERs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
>>
Thêm 1 chú nữa:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=37567
;;----------------------------------------------;;
;; Text calculation tool - Skywings ;;
;;----------------------------------------------;;
;;***SUB-FUNCTION***
(defun GET-TEXT ()
(princ "\nSelect NUMBERs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\n**NOTHING selected!**")
)
)
(defun GET-DATA (/ ss-mt ss-t n)
(setq ss-mt (ssadd)
ss-t (ssadd)
n 0
sw 0
)
(repeat (sslength Numbers)
(setq ent (ssname Numbers n))
(if (= (cdr (assoc 0 (entget ent))) "MTEXT")
(setq ss-mt (ssadd ent ss-mt))
(setq ss-t (ssadd ent ss-t))
)
(setq n (1+ n))
)
(if (/= (sslength ss-mt) 0)
(setq Numbers (acet-explode ss-mt)
sw 1
)
)
(setq n 0)
(repeat (sslength ss-t)
(setq ent (ssname ss-t n)
Numbers (ssadd ent Numbers)
n (1+ n)
)
)
)
(defun GET-VALUE (name / sw)
(princ (strcat "\nSelect " name " : "))
(cond
((= (cdr (assoc 0 (entget ename))) "MTEXT")
(command ".explode" ename "")
(setq value (read (cdr (assoc 1 (entget (entlast)))))
sw 1
)
)
((setq value (read (cdr (assoc 1 (entget ent))))))
)
(if (= sw 1)
(command ".undo" 1)
)
value
)
(defun OPT ()
(if (null option)
(setq option "Replace"
save2 option
)
)
(initget "Replace Create Do-nothing")
(setq
option
(getkword
(strcat "\nOptions: <"
option
"> "
)
)
)
(if (null option)
(setq option save2)
(setq save2 option)
)
(setq switch 1)
)
(defun ACTION (option result / txt pnt)
(cond
((= option "Replace")
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
(princ "\n**NOTHING selected!**")
)
(setq txt (entget (car txt))
txt (subst (cons 1 result) (assoc 1 txt) txt)
)
(entmod txt)
)
((= option "Create")
(setq pnt (getpoint "\nSpecify start point of text:"))
(entmake (list (assoc 0 ent)
(assoc 8 ent)
(cons 1 result)
(cons 10 (trans pnt 1 0))
(assoc 40 ent)
(assoc 7 ent)
(assoc 50 ent)
)
)
)
)
)
(defun GET-ORDER ()
(princ (strcat "\nCurrent setting: Precision = "
(rtos precision 2 0)
" <"
(rtos 0 2 precision)
">"
)
)
(initget
"Plus Subtract Multiply Divide Average maX-min ADd-by mUltiply-by preCision"
)
(setq operation
(getkword
(strcat
"\nOperations: : <"
operation
"> "
)
)
)
(if (null operation)
(setq operation save1)
(setq save1 operation)
)
)
;;***MAIN FUNCTION***:
(defun c:TCAL (/ Numbers DIVIDEND DIVISOR ENT ID
INDEX MINUEND NUM-MAX NUM-MIN NUM-SET
RESULT SUBTRAHEND SWITCH VALUE
sw
)
(princ
"** Text calculation tool - Skywings **"
)
(setvar "CMDECHO" 0)
(setvar "QAFLAGS" 1)
(if (null precision)
(setq precision 2
save3 precision
)
)
(if (null operation)
(setq operation "Plus"
save1 operation
)
)
(GET-ORDER)
(while (= operation "preCision")
(initget 4)
(setq
precision (getint (strcat "\nSpecify new precision: <"
(rtos precision 2 0)
"> "
)
)
)
(if (null precision)
(setq precision save3)
(setq save3 precision)
)
(GET-ORDER)
)
(cond
;; PLUS:
((= operation "Plus")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
(GET-DATA)
(setq index 0
result 0
)
(princ "\n>>Expression: ")
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(progn
(setq result (+ result value))
(if (/= index 1)
(princ " + ")
)
(princ (rtos value 2 precision))
)
)
)
(if (= sw 1) (command ".undo" 1))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
(OPT)
)
(ACTION option (rtos result 2 precision))
(setq Numbers nil
Numbers (ssget '((0 . "*TEXT")))
)
)
)
;; MULTIPLY:
((= operation "Multiply")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
(GET-DATA)
(setq index 0
result 1
)
(princ "\n>>Expression: ")
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(progn
(setq result (* result value))
(if (/= index 1)
(princ " * ")
)
(princ (rtos value 2 precision))
)
)
)
(if (= sw 1)
(command ".undo" 1)
)
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
(OPT)
)
(ACTION option (rtos result 2 precision))
(setq Numbers nil
Numbers (ssget '((0 . "*TEXT")))
)
)
)
;; SUBTRACT:
((= operation "Subtract")
(setq switch 0
sw 0
)
(while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : "))))))
(setq minuend (GET-VALUE "MINUEND"))
(while (null (numberp minuend))
(while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : "))))))
(setq minuend (GET-VALUE "MINUEND"))
)
(princ minuend)
(redraw ename 3)
(princ "\nSelect SUBTRAHENDs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect SUBTRAHENDs : ")
)
(redraw ename 4)
(while (/= ename nil)
(GET-DATA)
(setq index 0
result 0
minuend (float minuend)
)
(princ (strcat "\n>>Expression: "
(rtos minuend 2 precision)
" - ("
)
)
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
subtrahend (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp subtrahend)
(progn
(setq result (+ result subtrahend))
(if (/= index 1)
(princ " + ")
)
(princ (rtos subtrahend 2 precision))
)
)
)
(princ ")")
(if (= sw 1)
(command ".undo" 1)
)
(setq result (- minuend result))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
(OPT)
)
(ACTION option (rtos result 2 precision))
(setq ename nil
ename (car (entsel (strcat "\nSelect MINUEND : ")))
)
(if
(or
(null ename)
(null (numberp (setq minuend (GET-VALUE "MINUEND"))))
)
(progn
(setvar "QAFLAGS" 0)
(vl-exit-with-error "")
)
)
(princ minuend)
(princ "\nSelect SUBTRAHENDs <TEXT>: ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect SUBTRAHENDs : ")
)
)
)
;; DIVIDE:
((= operation "Divide")
(setq switch 0
sw 0
)
(while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : "))))))
(setq dividend (GET-VALUE "DIVIDEND"))
(while (null (numberp dividend))
(while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : "))))))
(setq dividend (GET-VALUE "DIVIDEND"))
)
(princ dividend)
(redraw ename 3)
(princ "\nSelect DIVISORs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect DIVISORs : ")
)
(redraw ename 4)
(while (/= ename nil)
(GET-DATA)
(setq index 0
result 1
dividend (float dividend)
)
(princ (strcat "\n>>Expression: "
(rtos dividend 2 precision)
" / ("
)
)
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
divisor (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp divisor)
(progn
(setq result (* result divisor))
(if (/= index 1)
(princ " * ")
)
(princ (rtos divisor 2 precision))
)
)
)
(princ ")")
(if (= sw 1)
(command ".undo" 1)
)
(setq result (/ dividend result))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
(OPT)
)
(ACTION option (rtos result 2 precision))
(setq ename nil
ename (car (entsel (strcat "\nSelect DIVIDEND : ")))
)
(if
(or
(null ename)
(null (numberp (setq dividend (GET-VALUE "DIVIDEND"))))
)
(progn
(setvar "QAFLAGS" 0)
(vl-exit-with-error "")
)
)
(princ dividend)
(princ "\nSelect DIVISORs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect DIVISORs : ")
)
)
)
;; AVERAGE:
((= operation "Average")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
(GET-DATA)
(setq index 0
id 0
result 0
)
(princ "\n>>Expression: (")
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(progn
(setq result (+ result value)
id (1+ id)
)
(if (/= index 1)
(princ " + ")
)
(princ (rtos value 2 precision))
)
)
)
(if (= sw 1) (command ".undo" 1))
(setq result (rtos (/ (float result) id) 2 precision))
(princ (strcat ") / " (rtos id 2 0)))
(princ (strcat "\n>>RESULT = " result))
(if (= switch 0)
(OPT)
)
(ACTION option result)
(setq Numbers nil
Numbers (ssget '((0 . "*TEXT")))
)
)
)
;; MAX-MIN:
((= operation "maX-min")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
(GET-DATA)
(setq index 0
Num-set nil
)
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(setq Num-set (cons value Num-set))
)
)
(setq Num-set (vl-sort Num-set '>)
num-max (car Num-set)
num-min (last Num-set)
result (strcat "MAX = "
(rtos num-max 2 precision)
" MIN = "
(rtos num-min 2 precision)
)
)
(if (= sw 1) (command ".undo" 1))
(princ "\n>>Numbers set: ")
(princ Num-set)
(print)
(princ result)
(if (= switch 0)
(OPT)
)
(ACTION option result)
(setq Numbers nil
Numbers (ssget '((0 . "*TEXT")))
)
)
)
;; ADD-BY...:
((= operation "ADd-by")
(if (null number0)
(setq number0 0.00
save4 number0
)
)
(setq number0 (getreal (strcat "Add by: <" (rtos number0 2 2) "> "))
index 0
)
(if (null number0)
(setq number0 save4)
(setq save4 number0)
)
(GET-TEXT)
(GET-DATA)
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(setq value (+ (float value) number0)
ent (subst (cons 1 (rtos value 2 precision))
(assoc 1 ent)
ent
)
)
)
(entmod ent)
)
)
;;MULTIPLY-BY...:
((= operation "mUltiply-by")
(if (null number0)
(setq number0 0.00
save4 number0
)
)
(setq number0 (getreal (strcat "Multiply by: <" (rtos number0 2 2) "> "))
index 0
)
(if (null number0)
(setq number0 save4)
(setq save4 number0)
)
(GET-TEXT)
(GET-DATA)
(repeat (sslength Numbers)
(setq ent (entget (ssname Numbers index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(setq value (* (float value) number0)
ent (subst (cons 1 (rtos value 2 precision))
(assoc 1 ent)
ent
)
)
)
(entmod ent)
)
)
)
(princ "<Exit>")
(setvar "QAFLAGS" 0)
(princ)
)


Tcal dùng lựa chọn AD (add-by) nhập hằng số K là -K nếu muốn trừ, K nếu muốn cộng
<<

Filename: 197760_tcal.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 197806
Tên lệnh: hat2u hau2t
chuyển bảng mã từ TCVN3 sang UNICODE


LIsp này dùng để: Chuyển text trên bản vẽ, từ TCVN3 => UNICODE, và ngược lại, từ UNICODE => TCVN3.

Filename: 197806_hat2u_hau2t.lsp
Tác giả: dunguss3581
Bài viết gốc: 197787
Tên lệnh: btd
Tác giả: almodeus
Bài viết gốc: 130536
Tên lệnh: boj
[Yêu cầu] 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_boj.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 197960
Tên lệnh: ha
[Yêu cầu]Lisp lấy text gần block

Đây bạn! Tôi mới test sơ sơ. Bạn test kỹ xem nhé!

Filename: 197960_ha.lsp
Tác giả: kedensau88
Bài viết gốc: 184626
Tên lệnh: e45
Cách lấy số liệu từ file txt
Các anh ơi cho em hỏi,em có 1 chương trình vẽ Elbowls45 như thế này :

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai...
>>
Các anh ơi cho em hỏi,em có 1 chương trình vẽ Elbowls45 như thế này :

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq mylist (list "Elbowls 45" "Elbowls 90" "Elbowls 180"))
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(start_list "NPS" 3)
(mapcar 'add_list lstType)
(end_list)
(start_list "mylist" 3)
(mapcar 'add_list mylist)
(end_list)
(action_tile "accept" "(setq ret (nth (atoi (get_tile \"NPS\")) lstType))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)

(defun c:e45 (/ PR RL )
(setq lst nil typ nil)
(or fn
(setq fn (findfile "Nhap ten file mac dinh vao day"))
(setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn
(progn
(setq PR (open fn "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst (append lst (list (list (car RL)(cdr RL))))
)
)
(close PR)
(setq typ (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst))))
(if (assoc typ lst)
(apply 'draw (cadr (assoc typ lst)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;--------------------------------------------------------------------------------
(defun draw (OD B / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")

P2(polar P1 0.0 (* B 2.414213562))
P3(polar P1 0.0 (* OD 0.5))
P4(polar P1 pi (* OD 0.5))
P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P2 P1)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P2 P3)
(command "circle" P2 P4)
(command "line" P2 P4 "")
(command "rotate" "b" P5 P6 "" P2 -45 "")
(command "line" P2 P4 "")
(command "zoom" "w" P7 P8)
(command "trim" "" P7 P8 "")
(setvar "osmode" OldOs)
(princ)
)


Bây giờ em muốn thêm 2 chương trình vẽ Elbowls90 và Elbowls180 vào chương trình trên mà để dc như cái Dialog(như hình vẽ) mà khi mình chọn loại Elbowls để vẽ thì nó sẽ vẽ dc Elbowls đó với các số liệu tương ứng thì em phải làm thế nào ạ.
http://farm3.anhso.net/upload/20111204/23/o/anhso-23456_2011-12-01_145908.jpg
Mong các anh giúp đỡ.Còn các chương trình Elbowls90,Elbowls180 và các số liệu tương ứng nằm trong tệp này ạ :
Download Elbowls.zip with Mup5
Em xin chân thành cảm ơn các anh nhiều.
<<

Filename: 184626_e45.lsp
Tác giả: kedensau88
Bài viết gốc: 197897
Tên lệnh: wn
Cách lấy số liệu từ file txt

Chào các anh,em có một đoạn lisp thế này :

(defun DCL ( lstType / fl ret dcl_id Return# add_lst )
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label =...
>>
Chào các anh,em có một đoạn lisp thế này :

(defun DCL ( lstType / fl ret dcl_id Return# add_lst )
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"ANSI B16.5 FORGED FLANGES\";"
" : boxed_column { label = \"Select The Type Of Flanges\";"
" : list_box { key = \"mylist\";width = 20;}"
" } "
" : boxed_column { label = \"Select Nominal Pipe Size\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : boxed_column { label = \"Select Wall Thickness\";"
" : edit_box {label = \"Wall Thichkness : t =\"; key = \"Tlon\"; edit_width = 8;}"
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun Get_lwn1()
(setq Tlon (atof (get_tile "Tlon"))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(add_lst "mylist" '("CLASS 150 FLANGES UNDER 8 INCH" "CLASS 300 FLANGES UNDER 8 INCH" "CLASS 400 FLANGES UNDER 8 INCH" "CLASS 600 FLANGES UNDER 8 INCH" "CLASS 900 FLANGES UNDER 8 INCH" "CLASS 1500 FLANGES UNDER 8 INCH" "CLASS 150 FLANGES 10-24 INCH" "CLASS 300 FLANGES 10-24 INCH" "CLASS 400 FLANGES 10-24 INCH" "CLASS 600 FLANGES 10-24 INCH" "CLASS 900 FLANGES 10-24 INCH" "CLASS 1500 FLANGES 10-24 INCH") 3)
(set_tile "mylist" "0")
(add_lst "NPS" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadadr lst)) 3)
(action_tile "mylist"
"(add_lst \"NPS\" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadr (assoc $value lst))) 3)"
)
(action_tile "accept"
"(setq ret (cons (get_tile \"mylist\")
(cadr
(nth (atoi (get_tile \"NPS\")) (cadr (assoc (get_tile \"mylist\") lst))))
)
)(Get_lwn1)(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)
(defun c:wn (/ PR RL lst0 lst1 lst2 lst3 lst4 lst5 lst40 lst41 lst42 lst43 lst44 lst45 val pt lst)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(or fn0
(setq fn0 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 150.txt"))
(setq fn0 (getfiled "Data Welding Neck Under 8 inch class 150" "" "txt" 2)))
(or fn1
(setq fn1 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 300.txt"))
(setq fn1 (getfiled "Data Welding Neck Under 8 inch class 300" "" "txt" 2)))
(or fn2
(setq fn2 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 400.txt"))
(setq fn2 (getfiled "Data Welding Neck Under 8 inch class 400" "" "txt" 2)))
(or fn3
(setq fn3 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 600.txt"))
(setq fn3 (getfiled "Data Welding Neck Under 8 inch class 600" "" "txt" 2)))
(or fn4
(setq fn4 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 900.txt"))
(setq fn4 (getfiled "Data Welding Neck Under 8 inch class 900" "" "txt" 2)))
(or fn5
(setq fn5 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 1500.txt"))
(setq fn5 (getfiled "Data Welding Neck Under 8 inch class 1500" "" "txt" 2)))
(or fn40
(setq fn40 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 150.txt"))
(setq fn40 (getfiled "Data Welding Neck Under 8 inch class 150" "" "txt" 2)))
(or fn41
(setq fn41 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 300.txt"))
(setq fn41 (getfiled "Data Welding Neck Under 8 inch class 300" "" "txt" 2)))
(or fn42
(setq fn42 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 400.txt"))
(setq fn42 (getfiled "Data Welding Neck Under 8 inch class 400" "" "txt" 2)))
(or fn43
(setq fn43 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 600.txt"))
(setq fn43 (getfiled "Data Welding Neck Under 8 inch class 600" "" "txt" 2)))
(or fn44
(setq fn44 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 900.txt"))
(setq fn44 (getfiled "Data Welding Neck Under 8 inch class 900" "" "txt" 2)))
(or fn45
(setq fn45 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 1500.txt"))
(setq fn45 (getfiled "Data Welding Neck Under 8 inch class 1500" "" "txt" 2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and fn0 fn1 fn2 fn3 fn4 fn5 fn40 fn41 fn42 fn43 fn44 fn45)
(progn
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn0 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst0 (append lst0 (list (list (car RL)(cdr RL))))
)
)
(setq lst0 (list "0" lst0))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn1 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst1 (append lst1 (list (list (car RL)(cdr RL))))
)
)
(setq lst1 (list "1" lst1))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn2 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst2 (append lst2 (list (list (car RL)(cdr RL))))
)
)
(setq lst2 (list "2" lst2))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn3 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst3 (append lst3 (list (list (car RL)(cdr RL))))
)
)
(setq lst3 (list "3" lst3))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn4 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst4 (append lst4 (list (list (car RL)(cdr RL))))
)
)
(setq lst4 (list "4" lst4))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn5 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst5 (append lst5 (list (list (car RL)(cdr RL))))
)
)
(setq lst5 (list "5" lst5))
(close PR)
(setq PR (open fn40 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst40 (append lst40 (list (list (car RL)(cdr RL))))
)
)
(setq lst40 (list "6" lst40))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn41 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst41 (append lst41 (list (list (car RL)(cdr RL))))
)
)
(setq lst41 (list "7" lst41))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn42 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst42 (append lst42 (list (list (car RL)(cdr RL))))
)
)
(setq lst42 (list "8" lst42))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn43 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst43 (append lst43 (list (list (car RL)(cdr RL))))
)
)
(setq lst43 (list "9" lst43))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn44 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst44 (append lst44 (list (list (car RL)(cdr RL))))
)
)
(setq lst44 (list "10" lst44))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn45 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst45 (append lst45 (list (list (car RL)(cdr RL))))
)
)
(setq lst45 (list "11" lst45))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq lst (list lst0 lst1 lst2 lst3 lst4 lst5 lst40 lst41 lst42 lst43 lst44 lst45))
(if
(and (setq val (DCL lst))
(setq pt (getpoint "\nStart Point:"))
)
(apply 'wna (append val (list pt)))
(princ "Error")
)
)
(princ "\nMissing File")
)
(princ)
)
;--------------------------------------------------------------------------------
(defun wna (Loai D X G tnho T1 A C D1 p1 / OldOS)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(setq
P2(polar P1 0.0 (/ G 2))
P3(polar P2 (/ pi 2) 1.6)
P4(polar P3 0.0 (/ (- D G) 2))
P5(polar P4 (/ pi 2) tnho)
P6(polar P5 pi (/ (- D X) 2))
P7(polar P1 (/ pi 2) (+ T1 1.6))
P8(polar P7 0.0 (/ A 2))
P9(polar P8 (* pi 1.5) 6)
P10(polar P8 pi Tlon)
P11(polar P10 (* pi 1.5) (+ T1 1.6))
P12(polar P3 0.0 (/ (- C G) 2))
P13(polar P12 pi (/ D1 2))
P14(polar P13 (/ pi 2) tnho)
P15(polar P12 0.0 (/ D1 2))
P16(polar P15 (/ pi 2) tnho)
P17(polar P1 (* pi 1.5) (/ T1 8))
P18(polar P7 (/ pi 2) (/ T1 8))
P19(polar P12 (* pi 1.5) (/ tnho 8))
P20(polar P12 (/ pi 2) (+ tnho (/ tnho 8)))
P21(polar P1 0.0 (/ D 2))
P22(polar P7 pi (/ D 2))
)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "line" P1 P2 P3 P4 P5 P6 P9 P8 P7 "")
(command "line" P10 P11 "")
(command "line" P13 P14 "")
(command "line" P15 P16 "")
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER2" "" "")
(command "line" P17 P18 "")
(command "line" P19 P20 "")
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "zoom" "a" "")
(command "zoom" "w" P21 P22)
(COMMAND "MIRROR" "BOX" P21 P7 "" P1 P7 "" )
(setvar "osmode" OldOs)
(princ)
)


Nếu viết như thế này thì em thấy cách lấy file dữ liệu có vẻ dài quá,có cách nào để làm ngắn gọn lại không vậy các anh ??

Thanks !!!!



Vâng,đúng là đoạn Lisp này em có nhờ anh viết.
Nhưng cái đoạn anh nói ở trên em vẫn ko hiểu rõ lắm cách viết lại thành 1 hàm con đó. :wacko: :wacko:
<<

Filename: 197897_wn.lsp
Tác giả: kedensau88
Bài viết gốc: 184780
Tên lệnh: e45 e90 e180
Cách lấy số liệu từ file txt

Bước 1,2 của em làm như thế này đúng chưa anh :mellow:

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog {...
>>

Bước 1,2 của em làm như thế này đúng chưa anh :mellow:

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq mylist (list "Elbowls 45" "Elbowls 90" "Elbowls 180"))
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(start_list "NPS" 3)
(mapcar 'add_list lstType)
(end_list)
(start_list "mylist" 3)
(mapcar 'add_list mylist)
(end_list)
(action_tile "accept" "(setq ret (nth (atoi (get_tile \"NPS\")) lstType))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:e45 (/ PR RL )
(setq lst nil typ nil)
(or fn
(setq fn (findfile "Nhap ten file mac dinh vao day"))
(setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn
(progn
(setq PR (open fn "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst (append lst (list (list (car RL)(cdr RL))))
)
)
(close PR)
(setq typ (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst))))
(if (assoc typ lst)
(apply 'draw (cadr (assoc typ lst)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:e90 (/ PR1 RL1 )
(setq lst1 nil typ1 nil)
(or fn1
(setq fn1 (findfile "Nhap ten file mac dinh vao day"))
(setq fn1 (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn1
(progn
(setq PR1 (open fn1 "r") RL1 (read-line PR1))
(while (setq RL1 (read-line PR1))
(setq RL1 (read (strcat "(" RL1 ")"))
lst1 (append lst1 (list (list (car RL1)(cdr RL1))))
)
)
(close PR1)
(setq typ1 (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst1))))
(if (assoc typ1 lst1)
(apply 'draw1 (cadr (assoc typ1 lst1)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:e180 (/ PR2 RL2 )
(setq lst2 nil typ2 nil)
(or fn2
(setq fn2 (findfile "Nhap ten file mac dinh vao day"))
(setq fn2 (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn2
(progn
(setq PR2 (open fn2 "r") RL2 (read-line PR2))
(while (setq RL2 (read-line PR2))
(setq RL2 (read (strcat "(" RL2 ")"))
lst2 (append lst2 (list (list (car RL2)(cdr RL2))))
)
)
(close PR2)
(setq typ2 (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst2))))
(if (assoc typ2 lst2)
(apply 'draw2 (cadr (assoc typ2 lst2)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;--------------------------------------------------------------------------------
(defun draw (OD B / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")

P2(polar P1 0.0 (* B 2.414213562))
P3(polar P1 0.0 (* OD 0.5))
P4(polar P1 pi (* OD 0.5))
P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P2 P1)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P2 P3)
(command "circle" P2 P4)
(command "line" P2 P4 "")
(command "rotate" "b" P5 P6 "" P2 -45 "")
(command "line" P2 P4 "")
(command "zoom" "w" P7 P8)
(command "trim" "" P7 P8 "")
(setvar "osmode" OldOs)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun draw1 (OD A / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")
P2(polar P1 (/ pi 2) A)
P3(polar P2 (* pi 1.5) (/ OD 2))
P4(polar P2 (/ pi 2) (/ OD 2))
P5(polar P1 pi (+ A (/ OD 2)))
P6(list (+ (car P1) (+ A (/ OD 2))) (- (cadr P1) (+ A (/ OD 2))) (caddr P1))
P7(list (- (car P1) (/ A 4)) (+ (cadr P1) (/ A 4)) (caddr P1))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P1 P4 "")
(command "line" P1 P5 "")
(command "zoom" "w" P6 P4)
(command "TRIM" "" P6 P7 "")
(setvar "osmode" OldOs)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun draw2 (OD O / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")

P2(polar P1 pi (* O 0.5))
P3(polar P2 0.0 (* OD 0.5))
P4(polar P2 pi (* OD 0.5))
P5(polar P1 0.0 (* 0.5 (+ O OD)))
P6(list (+ (car P1) (* 1 O)) (- (cadr P1) (* O 1)) (caddr P1))
P7(list (- (car P1) (* 0.25 (- O OD))) (+ (cadr P1) (* 0.25 (- O OD))) (caddr P1))
P8(list (- (car P1) (* 1 O)) (+ (cadr P1) (* O 1)) (caddr P1))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P4 P5 "")
(command "zoom" "w" P6 P8)
(command "trim" "" P6 P7 "")
(setvar "osmode" OldOs)
(princ)
)

<<

Filename: 184780_e45_e90_e180.lsp
Tác giả: Snowman
Bài viết gốc: 63321
Tên lệnh: slb
Viết Lisp theo yêu cầu

Xin fép tác giả, em cải biên đoạn lisp này đi một chút (nhân tiện có việc cần dùng đến :lol2: Em có một cái trích xuất cả bảng dữ liệu sang excel nhưng chỉ tiện cho việc trình bày, ko tiện thống kê khối lượng)

(Cái codebox này vẫn chưa bỏ được lỗi emotion nhỉ paste code vào mà ko để...
>>

Xin fép tác giả, em cải biên đoạn lisp này đi một chút (nhân tiện có việc cần dùng đến :lol2: Em có một cái trích xuất cả bảng dữ liệu sang excel nhưng chỉ tiện cho việc trình bày, ko tiện thống kê khối lượng)

(Cái codebox này vẫn chưa bỏ được lỗi emotion nhỉ paste code vào mà ko để ý là hỏng luôn)
(Lâu lắm rồi mới "tái xuất" CADVIET :lol2: )
<<

Filename: 63321_slb.lsp
Tác giả: tuan138
Bài viết gốc: 198085
Tên lệnh: sd
Lisp sắp xếp DIM

(defun c:sd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun hoanh_newerror (msg)
(if (and (/= msg "Function cancelled")
(/= msg "quit / exit abort")
>>

(defun c:sd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun hoanh_newerror (msg)
(if (and (/= msg "Function cancelled")
(/= msg "quit / exit abort")
)
(princ (strcat "\n" msg))
)
(done)
)
;;----------
(defun init ()
(setq
HOANH_CMD (getvar "CMDECHO")
HOANH_OLDERROR *error*
*error* hoanh_newerror
)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
)
;;----------
(defun done ()
(command ".redraw")
(command ".undo" "E")
(if HOANH_CMD
(setvar "CMDECHO" HOANH_CMD)
)
(if HOANH_OLDERROR
(setq *error* HOANH_OLDERROR)
)
(princ)
)
;;----------
(defun cdim (entdt pchan pduong / tt old10
old13 old14 new10 new13 new14 p10n
p13n p14n p10o p13o p14o gocduong
gocchan pchanb pduongb loaidim
)
(defun chanvuonggoc (ph p1 p2 / ptemp pkq goc)
(setq
goc (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq (inters ph ptemp p1 p2 nil)
)
pkq
)
(setq
tt (entget entdt)
old10 (assoc '10 tt)
old13 (assoc '13 tt)
old14 (assoc '14 tt)
p10o (cdr old10)
p13o (cdr old13)
p14o (cdr old14)
loaidim (logand (cdr (assoc '70 tt)) 7)
gocduong (cond
((= loaidim 1) (angle p13o p14o))
((= loaidim 0) (cdr (assoc '50 tt)))
(t nil)
)
pchan (cond
(pchan (list (car pchan) (cadr pchan) 0.0))
(t pchan)
)
pduong (cond
(pduong (list (car pduong) (cadr pduong) 0.0))
(t pduong)
)
)
(if gocduong
(progn
(if pchan
(setq
pchanb (polar pchan gocduong 1000.0)
p13n (chanvuonggoc
(list (car p13o) (cadr p13o) 0.0)
pchan
pchanb
)
p14n (chanvuonggoc
(list (car p14o) (cadr p14o) 0.0)
pchan
pchanb
)
new13 (cons 13 p13n)
new14 (cons 14 p14n)
tt (subst new13 old13 tt)
tt (subst new14 old14 tt)
)
)
(if pduong
(setq
pduongb (polar pduong gocduong 1000.0)
p10n (chanvuonggoc
(list (car p10o) (cadr p10o) 0.0)
pduong
pduongb
)
new10 (cons 10 p10n)
tt (subst new10 old10 tt)
)
)
(entmod tt)
)
)
gocduong
)
(defun textdimheight (ent / tmp)
(command ".copy" ent "" (list 0.0 0.0 0.0) "@")
(command ".explode" (entlast) "")
(setq tmp (cdr (assoc 40 (entget (entlast)))))
(command ".erase" "p" "")
tmp
)
(defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
(setq
x1 (car p1)
y1 (cadr p1)
z1 (caddr p1)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
x3 (car p3)
y3 (cadr p3)
z3 (caddr p3)
tmp (+ (* (- x1 x2) x3)
(* (- y1 y2) y3)
(* (- z1 z2) z3)
)
)
(cond
((= tmp 0.0) 0.0)
(t (/ tmp (abs tmp)))
)
)
(defun khoangcachdim (p1 ent goc / tt p2 A B D)
(setq tt (entget ent)
p2 (cdr (assoc 10 tt))
B (cdr (assoc 50 tt))
A (angle p1 p2)
D (distance p1 p2)
)
(* (* D (sin (- A B ))) (phia p1 (polar p1 goc 1.0) p2))
)
(defun phanloai (ent)
(setq
kc (khoangcachdim pgoc ent goc)
loai (fix (/ kc heightdimgoc 0.93))
)
(cons loai ent)
)
(init)
(princ "\nSap xep dim &#169; CADViet.com")
(while (not (setq entgoc (car (entsel "\nChon duong dim goc: "))))
)
(setq
ttgoc (entget entgoc)
p13goc (cdr (assoc 13 ttgoc))
pgoc (cdr (assoc 10 ttgoc))
goc (cdr (assoc 50 ttgoc))
heightdimgoc (textdimheight entgoc)
ssd (ssget (list
(cons 0 "DIMENSION")
(cons -4 ") (cons="" 70="" 32)="" 64)="" 96)="" 128)="" 160)="" 196)="" 224)="" -4="" "or="">")
(cons -4 ") (cons="" 50="" goc)="" (+="" goc="" pi))="" (-="" -4="" "or="">")
)
)
lstd (ss2ent ssd)
lstd (mapcar 'phanloai lstd)
lstlevel nil
)
(foreach pp lstd
(if (not (member (car pp) lstlevel))
(setq lstlevel (append lstlevel (list (car pp))))
)
)
(setq lstlevel (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
lstam nil
lstduong nil
lstamtmp nil
lstduongtmp nil
)
(foreach pp lstlevel
(if (< pp 0.0)
(setq lstam (append lstam (list pp)))
)
(if (> pp 0.0)
(setq lstduong (append lstduong (list pp)))
)
)
(setq index 0)
(foreach pp (reverse lstam)
(setq
index (1+ index)
lstamtmp (append lstamtmp (list (cons pp index)))
)
)
(setq
lstam lstamtmp
index 0
)
(foreach pp lstduong
(setq
index (1+ index)
lstduongtmp (append lstduongtmp (list (cons pp index)))
)
)
(setq lstduong lstduongtmp)
(setq lstlevel (append lstduong lstam (list (cons 0.0 0))))
(setq kcdimstandard (* 3.0 heightdimgoc))
(foreach pp lstd
(setq plht (car pp))
(progn
(setq
kcdimht (khoangcachdim pgoc (cdr pp) goc)
duongthu (cdr (assoc plht lstlevel))
heso (cond
((/= 0 kcdimht)
(abs (* (/ kcdimstandard kcdimht) duongthu))
)
(t 0.0)
)
diemchenht (cdr (assoc 10 (entget (cdr pp))))
pmoi (polar pgoc
(angle pgoc diemchenht)
(* heso (distance pgoc diemchenht))
)
)
(cdim (cdr pp) p13goc pmoi)
)
)
(done)
)
(princ "\nSap xep dim, SD - free lisp from www.cadviet.com")
(princ)


nhập lệnh sd, báo "chon doi tuong". chọn xong thì bị lỗi

Chon duong dim goc: Unknown command "SD". Press F1 for help.
too many arguments
- Chưa load lisp nào khác
- Chưa có lệnh sd trùng

Cao thủ nào giúp em với nhé! Thanks
<<

Filename: 198085_sd.lsp
Tác giả: q288
Bài viết gốc: 56891
Tên lệnh: chk
Bắt text vào polyline


Mình có viết ct này cho yêu cầu của bạn, hy vọng sẹ chạy tốt. Tên lệnh chk.
Khi điểm chèn của text ko nẳm trên pline hoặc độ nghiêng text chênh với độ nghiêng pline quá 10 độ thì sẽ báo lỗi bằng poỉnt.


Filename: 56891_chk.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 198103
Tên lệnh: sd
Lisp sắp xếp DIM

Hơi vất vả khi phải sửa lisp bị lỗi vì những ký tự đặc biệt (chứ bản chất lisp không lỗi).
Đây, bạn xem:

Filename: 198103_sd.lsp
Tác giả: TRUNGNGAMY
Bài viết gốc: 72190
Tên lệnh: vetd
nối điểm lại theo kiểu polyline

Mình làm một ví dụ điển hình giúp bạn. Dữ liệu tọa độ là một file text, x và y cách nhau khoảng trắng

Filename: 72190_vetd.lsp
Tác giả: Thaistreetz
Bài viết gốc: 198112
Tên lệnh: tmk
- Lisp thay thế lệnh textmask của Express tool
Lệnh Textmask của express tool "hơi bị ngu". Nó sẽ xử đẹp đối tượng text nếu text của bạn là Annotative text. (Hoặc có thể mình ngu vì kiếm hoài không ra chỗ để thiết lập cho nó chạy suôn sẻ với Annotative text.)
Thế nên mình viết lại lệnh này để có thể dùng với cả text thường lẫn Annotative text. khỏi sợ vô tình text bay đâu mất.

;;; Textmask for Annotative Text - Copyright...
>>
Lệnh Textmask của express tool "hơi bị ngu". Nó sẽ xử đẹp đối tượng text nếu text của bạn là Annotative text. (Hoặc có thể mình ngu vì kiếm hoài không ra chỗ để thiết lập cho nó chạy suôn sẻ với Annotative text.)
Thế nên mình viết lại lệnh này để có thể dùng với cả text thường lẫn Annotative text. khỏi sợ vô tình text bay đâu mất.

;;; Textmask for Annotative Text - Copyright 2012 Thaistreetz - Cadviet.com
(defun c:TMK (/ DXF MakeWipeout ss->list MakeGroup ss pt1 dk oset wipeout)
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun MakeWipeout (listpoint Layer Color xdata / dxf10 max_dist cen dxf14)
(if (and (< (atof (getvar "acadver")) 19) (not (member "acwipeout.arx" (arx)))) (arxload "acwipeout.arx"))
(setq dxf10 (list(apply'min(mapcar'car listpoint))(apply'min(mapcar'cadr listpoint))(if(caddar listpoint)(caddar listpoint)0))
max_dist(float(apply'max(mapcar'-(apply'mapcar(cons'max listpoint))dxf10)))
cen (mapcar'+ dxf10(list(/ max_dist 2)(/ max_dist 2) 0.0))
dxf14 (mapcar'(lambda(p)(mapcar'/(mapcar'- p cen)(list max_dist(- max_dist)1.0)))listpoint)
dxf14 (reverse(cons(car dxf14)(reverse dxf14))))
(entmakex (append (list
'(0 . "WIPEOUT")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbWipeout")'(90 . 0)
(cons 10 (trans dxf10 (list 0 0 1) 0))
(cons 11 (trans (list max_dist 0.0 0.0) (list 0 0 1) 0))
(cons 12 (trans (list 0.0 max_dist 0.0) (list 0 0 1) 0))
'(13 1.0 1.0 0.0)'(70 . 7)'(280 . 1)'(71 . 2)
(cons 91 (length dxf14)))
(mapcar'(lambda(p)(cons 14 p))dxf14)
(list (cons -3 (if xdata (list xdata) nil))))))
(defun ss->list (ss / i lst)
(if ss (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst)))))
(defun MakeGroup (lstEname Description / dict ind)
(setq dict (dictsearch (namedobjdict) "ACAD_GROUP") ind "GRP1")
(while (member (cons 3 ind) dict) (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4)))))))
(dictadd (cdr (assoc -1 dict)) ind (entmakex (append (list '(0 . "GROUP")'(100 . "AcDbGroup")(cons 300 Description)'(70 . 0)'(71 . 1))(mapcar'(lambda(x)(cons 340 x))lstEname)))));end
(command "undo" "begin")
(prompt (Strcat "<< he so ffset hien hanh = "
(rtos (setq OSET (if (acet-getvar '("acet_textmask_offset")) (acet-getvar '("acet_textmask_offset")) 0.25)) 2 4)
" >>\nChon text: "))
(setq dk (grread nil 14 2))
(while DK
(if (= (car DK) 3)
(setq PT1 (cadr DK) ss (ss->list (ssget "C" PT1 (getcorner PT1) '((0 . "TEXT")))) dk nil)
(if (or (equal DK '(2 111)) (equal DK '(2 79)))
(progn
(prompt "")
(grread nil 14 2) (setq oset (getreal " - nhap he so: "))
(acet-setvar (list "acet_textmask_offset" oset 3))
(setq dk (grread nil 14 2)))
(setq dk (grread nil 14 2)))))
(foreach ss ss
(setq wipeout (MakeWipeout (mapcar'(lambda (x) (trans x 1 0)) (acet-geom-textbox(entget ss) oset)) (dxf 8 ss) nil nil))
(command "DRAWORDER" ss "" "f")
(MakeGroup (list wipeout ss) (DXF 1 ss)))
(command "undo" "end")(princ))


Lưu ý:
- Lệnh này viết mục đích thay thế lệnh textmask, nhưng không có nghĩa là bạn không cần cài đặt express tool. Do lisp sử dụng chung hệ số offset với lệnh textmask và một số hàm của express tool nên bạn bắt buộc fải cài mới dùng được.
- Để điều chỉnh hệ số offset, nhấn fím O trước khi chọn đối tượng.
<<

Filename: 198112_tmk.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 198213
Tên lệnh: tkh
Tác giả: Doan Van Ha
Bài viết gốc: 198262
Tên lệnh: a2f
cần giúp đỡ: LISP KHÔNG CHẠY
Lisp này của Lee Mac, bạn copy bị lỗi. Bản gốc đây:

Filename: 198262_a2f.lsp

Trang 88/301

88