20 tháng 2, 2016

AutoLISP ghi tọa độ XY bản vẽ phay, tọa độ 2XZ bản vẽ tiện

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

Đăng bởi: blue Vào lúc: 19:38 Danh mục:

0 nhận xét:

Đăng nhận xét

Bình Luận Mới

Weblog forum mới nhất

Máy tính mới nhất

Cơ khí mới nhất

Nhãn