Translate

Showing posts with label AutoCAD Autolisp. Show all posts
Showing posts with label AutoCAD Autolisp. Show all posts

Saturday, January 21, 2012

AutoCAD x,y, coordinates lisp command

Pick and Write Points coordinates by single click lisp command for AutoCAD

Procedure:
Copy Highlighted,

(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 (rtos (car pnt) 2 3) " D")
                  ntxt (strcat (rtos (cadr pnt) 2 3) " L")
            );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

Open Notepad --> paste into notepad --> File --> Save as --> xy.lsp (in the file type, select All Files)
From Autocad --> Tools --> Load Application --> select this file --> Close
Tip: if required this application in every drawing, contents --> Add --> Select file --> Add -- Close --> Close.

At Autocad command line
x --> click point . ok

Tuesday, January 17, 2012

Area Calculate and Writing AutoLisp

AutoCAD AutoLisp.
Calculate the area and write any where in drawing by just 1 click.
Procedure:

Copy highlighted
(defun c:Q()
(COMMAND "ORTHO" "OFF")
(COMMAND "F3")
(setq d1 (getpoint "\nClick inside the object"))
(COMMAND "-boundary" d1 "")
(COMMAND "area" "o" "l" "")
(setq p2 (getpoint "\npoint1"))
(setq str (getvar "area"))
(setq str2 (rtos str 2 3))
(command "text" "M" p2 ".25" "0" str2)
)
(COMMAND "OSNAP" "ON")


Open Notepad --> paste into notepad --> File --> Saveas --> Qty.lsp (in the file type, select All Files)
From Autocad --> Tools --> Load Application --> select this file --> Close

Tip: if required this application in every drawing, contents --> Add --> Select file --> Add -- Close --> Close.

At Autocad command line
q--> click inside the object --> than click where like to write calculated area. ok