Code AutoLISP ghi tọa độ XY bản vẽ phay:
(defun err (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(errestore)
)
(defun errinit ()
(setq olderr *error*
*error* err
DT (getvar "dimtad") ;Save DIMTAD
AB (getvar "angbase") ;Save ANGBASE
AD (getvar "angdir") ;Save ANGDIR
)
(setvar "dimtad" 0) ;Set DIMTAD = 0
(setvar "angbase" 0) ;Set ANGBASE = 0
(setvar "angdir" 0) ;Set ANGDIR = 0
)
(defun errestore ()
(setvar "dimtad" DT) ;Restore DIMTAD
(setvar "angbase" AB) ;Restore ANGBASE
(setvar "angdir" AD) ;Restore ANGDIR
(setq *error* olderr)
(princ)
)
(defun c:x (/ olderr DT AB AD olddflt dflt prmpt pnt etxt ntxt ctxt
ename ent txtpnt txthgt txtjst)
(errinit)
(setq dflt "2-lines"
prmpt (strcat "\n <" dflt ">/1-line/<coord point>: "))
(initget "2-lines 1-line")
(while (setq pnt (getpoint prmpt))
(if (/= (type pnt) 'LIST)
(progn
(setq olddflt dflt dflt pnt)
(if (= dflt "Undo")
(progn
(command "u")
(setq dflt olddflt)
);end progn
);end if
);end progn
(progn
(command "undo" "group")
(if (= dflt "2-lines")
(progn
(setq etxt (strcat " X" (rtos (car pnt) 2 3))
ntxt (strcat " Y" (rtos (cadr pnt) 2 3))
);end setq
(setvar "texteval" 1)
(if (= (substr (getvar "acadver") 1 2) "12")
(progn
(command "dim1" "leader" pnt pause "" etxt)
(setvar "texteval" 0)
(setq ename (entlast)
ent (entget ename)
txtpnt (cdr (assoc 11 ent))
txthgt (cdr (assoc 40 ent))
);end setq
(if (= (cdr (assoc 72 ent)) 0)(setq txtjst "ml")(setq txtjst "mr"))
(setvar "texteval" 1)
(command "text" txtjst txtpnt txthgt 0 "")
(command "text" "" ntxt)
);end progn
(command "leader" pnt pause "" etxt ntxt "")
);end if
(setvar "texteval" 0)
);end progn
);end if
(if (= dflt "1-line")
(progn
(setq ctxt (strcat (rtos (car pnt) 2 3) " D, " (rtos (cadr pnt) 2 3) " L"))
(setvar "texteval" 1)
(if (= (substr (getvar "acadver") 1 2) "12")
(command "dim1" "leader" pnt pause "" ctxt)
(command "leader" pnt pause "" ctxt "")
);end if
(setvar "texteval" 0)
);end progn
);end if
(command "undo" "end")
);end progn
);end if
(cond ((= dflt "2-lines") (setq prmpt (strcat "\n <" dflt ">/1-line/Undo/<coord point>: ")))
(T (setq prmpt (strcat "\n <" dflt ">/2-lines/Undo/<coord point>: ")))
);end cond
(initget "2-lines 1-line Undo")
);end while
(errestore)
);end defun
Code AutoLISP ghi tọa độ 2XZ bản vẽ tiện:
;Toa do 2XZ trong tien CNC
;Edit: blue79blog@gmail | Phone: 0169 697 9387
;Update: 20/02/2016
(defun err (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(errestore)
)
(defun errinit ()
(setq olderr *error*
*error* err
DT (getvar "dimtad") ;Save DIMTAD
AB (getvar "angbase") ;Save ANGBASE
AD (getvar "angdir") ;Save ANGDIR
)
(setvar "dimtad" 0) ;Set DIMTAD = 0
(setvar "angbase" 0) ;Set ANGBASE = 0
(setvar "angdir" 0) ;Set ANGDIR = 0
)
(defun errestore ()
(setvar "dimtad" DT) ;Restore DIMTAD
(setvar "angbase" AB) ;Restore ANGBASE
(setvar "angdir" AD) ;Restore ANGDIR
(setq *error* olderr)
(princ)
)
(defun c:xz (/ olderr DT AB AD olddflt dflt prmpt pnt etxt ntxt ctxt
ename ent txtpnt txthgt txtjst)
(errinit)
(setq dflt "2-lines"
prmpt (strcat "\n blue79blog@gmail.com | 2XZ "))
(initget "2-lines 1-line")
(while (setq pnt (getpoint prmpt))
(if (/= (type pnt) 'LIST)
(progn
(setq olddflt dflt dflt pnt)
(if (= dflt "Undo")
(progn
(command "u")
(setq dflt olddflt)
);end progn
);end if
);end progn
(progn
(command "undo" "group")
(if (= dflt "2-lines")
(progn
(setq etxt (strcat " 2X" (rtos (abs (* 2 (cadr pnt))) 2 3))
ntxt (strcat " Z" (rtos (car pnt) 2 3))
);end setq
(setvar "texteval" 1)
(if (= (substr (getvar "acadver") 1 2) "12")
(progn
(command "dim1" "leader" pnt pause "" etxt)
(setvar "texteval" 0)
(setq ename (entlast)
ent (entget ename)
txtpnt (cdr (assoc 11 ent))
txthgt (cdr (assoc 40 ent))
);end setq
(if (= (cdr (assoc 72 ent)) 0)(setq txtjst "ml")(setq txtjst "mr"))
(setvar "texteval" 1)
(command "text" txtjst txtpnt txthgt 0 "")
(command "text" "" ntxt)
);end progn
(command "leader" pnt pause "" etxt ntxt "")
);end if
(setvar "texteval" 0)
);end progn
);end if
);end progn
);end if
);end while
(errestore)
);end defun
Giải thích:
1. Hàm (car ...)
- CHỨC NĂNG: Hoàn trả phần đầu tiên của danh sách. Kết quả là một giá trị, kiểu là kiểu của thành phần đó.
- CÚ PHÁP: (car list)
- GIẢI THÍCH: list: Là một danh sách
2. Hàm (cadr ...)
- CHỨC NĂNG: Hoàn trả phần phần tử thứ 2 của danh sách. Kết quả là một giá trị, kiểu là kiểu của thành phần đó.
- CÚ PHÁP: (cadr list)
f. Hàm (rtos...)
- CHỨC NĂNG: Chuyển đổi số thực thành chuỗi ký tự
- CÚ PHÁP: (rtos number [mode [precision]])
- GIẢI THÍCH:
number : Là một số
mode: Là mã điều khiển dạng xuất ra chuỗi ký tự
Mode nhận các giá trị sau:
1 : Dạng khoa học
2 : Dạng thập phân
3 : Dạng kỹ thuật
4 : Dạng kiến trúc
5 : Dạng hữu tỷ (phân số)
precision : Là độ chính xác (số chữ số sau dấu phảy thập phân)
Xem thêm: http://www.vietlisp.com/autolisp/ngon-ngu-autolisp
0 nhận xét:
Đăng nhận xét