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
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
please give me a link for xyleft application
ReplyDelete