LISP won't reset to Origi
Hi Guys,This is probably a really silly mistake on my part - but my LISP will not reset back to the original current layer settings after the user has completed the function.
The LISP is created to tag orientation labels on tanks, after the user has specified input data such as drawing scale, label length and angle increment.
Here is the LISP:
;| Tank Orientation Label by Lee McDonnell (November 2008) SYNTAX:"TOL"|;(defun dtr (a) (* pi (/ a 180.0))) ; end dtr(defun rtd (b) (* 180.0 (/ b pi))) ; end rtd(defun CreateLayer (Name) (if (not (tblsearch "LAYER" Name)) (command "_.-layer" "_m" Name "_c" Name Name "") ); end if); end ofCreateLayer(defun *error*(msg) (if oldVars (mapcar 'setvar varLstoldVars) ); end if (princ "\nError or Esc pressed... ") (princ)); end of *error*(defun c:TOL (/ oldlay oldsnap dwgscale tkcirc tkent tkcent line1 l1ent llen inc ang1 txtpt ang2) (setq varLst (list "CMDECHO" "OSMODE" "CLAYER" "DIMSCALE") oldVars (mapcar 'getvar varLst) ); end setq (setq oldlay (getvar "clayer")) (setq oldsnap (getvar "osmode")) (setq oldortho (getvar "orthomode")) (setvar "cmdecho" 0) (mapcar 'CreateLayer '("1" "2" "3" "4" "5")) (if (/= (setq dwgscale (getreal "\nSpecify Drawing Scale: 1:")) nil) (progn (while (/= (setq tkcirc (car (entsel "\nSelect Tank Outer Shell: "))) nil) (setq tkent (entget tkcirc)) (if (= (cdr (assoc 0 tkent)) "CIRCLE") (progn (setq tkcent (cdr (assoc 10 tkent))) (setvar "orthomode" 1) (princ "\nSpecify Length of Primary Label: ") (command "_line" tkcent pause "" ) ; end line (setq line1 (entlast)) (setq l1ent (entget line1)) (setq llen (distance (cdr (assoc 10 l1ent)) (cdr (assoc 11 l1ent)) ) ; end distance ) ; end setq (entdel line1) (setvar "orthomode" 0) (if (and (> (setq inc (getreal "\nSpecify Angle Increment: ")) 0) (< inc 360) ) ; end and (progn (setvar "osmode" 0) (setq inc (dtr inc)) (setq ang1 0) (while (< ang1 (* 2 pi)) (setvar "clayer" "5") (command "_line" tkcent (polar tkcent ang1 llen ) ; end polar "" ) ; end line (setq txtpt (polar tkcent ang1 (* llen 1.12) ) ; end polar ) ; end setq (setq ang2 (strcat (rtos (rtd ang1)) "%%D" ) ; end strcat ) ; end setq (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txtpt) (cons 40 (* dwgscale 2.5)) (cons 1 ang2) '(50 . 0.0) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txtpt) ) ; end list ) ; end entmake (setvar "clayer" oldlay) (setq ang1 (+ inc ang1)) ) ; end while ) ; end progn (alert "\nAngle Increment must be Positive and Non-zero. ") ) ; end if ) ; end progn (alert "\nEntity Selected is not a Circle.") ) ; end if ) ; end while ) ; end progn (alert "\nDrawing Scale must be Positive and Non-zero. ") ) ; end if (setvar "cmdecho" 1) (setvar "osmode" oldsnap) (setvar "orthomode" oldortho) (princ "\nFunction Complete. ") (princ)) ; end function try this (not tested)
;| Tank Orientation Label by Lee McDonnell (November 2008) SYNTAX:"TOL"|;(defun dtr (a) (* pi (/ a 180.0))) ; end dtr(defun rtd (b) (* 180.0 (/ b pi))) ; end rtd(defun CreateLayer (Name) (if (not (tblsearch "LAYER" Name)) (command "_.-layer" "_m" Name "_c" Name Name "") ); end if); end ofCreateLayer(defun *error*(msg) (if oldVars (mapcar 'setvar varLstoldVars) ); end if (princ "\nError or Esc pressed... ") (princ)); end of *error*(defun c:TOL (/dwgscale tkcirc tkent tkcent line1 l1ent llen inc ang1 txtpt ang2 *error*) (setq varLst (list "CMDECHO" "OSMODE" "CLAYER" "DIMSCALE" "ORTHOMODE") oldVars (mapcar 'getvar varLst) ); end setq ;;(setq oldlay (getvar "clayer")) ;;(setq oldsnap (getvar "osmode")) ;;(setq oldortho (getvar "orthomode")) (setvar "cmdecho" 0) (mapcar 'CreateLayer '("1" "2" "3" "4" "5")) (if (/= (setq dwgscale (getreal "\nSpecify Drawing Scale: 1:")) nil) (progn (while (/= (setq tkcirc (car (entsel "\nSelect Tank Outer Shell: "))) nil) (setq tkent (entget tkcirc)) (if (= (cdr (assoc 0 tkent)) "CIRCLE") (progn (setq tkcent (cdr (assoc 10 tkent))) (setvar "orthomode" 1) (princ "\nSpecify Length of Primary Label: ") (command "_line" tkcent pause "" ) ; end line (setq line1 (entlast)) (setq l1ent (entget line1)) (setq llen (distance (cdr (assoc 10 l1ent)) (cdr (assoc 11 l1ent)) ) ; end distance ) ; end setq (entdel line1) (setvar "orthomode" 0) (if (and (> (setq inc (getreal "\nSpecify Angle Increment: ")) 0) (< inc 360) ) ; end and (progn (setvar "osmode" 0) (setq inc (dtr inc)) (setq ang1 0) (while (< ang1 (* 2 pi)) (setvar "clayer" "5") (command "_line" tkcent (polar tkcent ang1 llen ) ; end polar "" ) ; end line (setq txtpt (polar tkcent ang1 (* llen 1.12) ) ; end polar ) ; end setq (setq ang2 (strcat (rtos (rtd ang1)) "%%D" ) ; end strcat ) ; end setq (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txtpt) (cons 40 (* dwgscale 2.5)) (cons 1 ang2) '(50 . 0.0) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txtpt) ) ; end list ) ; end entmake ;;(setvar "clayer" oldlay) (setq ang1 (+ inc ang1)) ) ; end while ) ; end progn (alert "\nAngle Increment must be Positive and Non-zero. ") ) ; end if ) ; end progn (alert "\nEntity Selected is not a Circle.") ) ; end if ) ; end while ) ; end progn (alert "\nDrawing Scale must be Positive and Non-zero. ") ) ; end if;;(setvar "cmdecho" 1) ;;(setvar "osmode" oldsnap) ;;(setvar "orthomode" oldortho)(*error* nil) ;_force error function at end to restore variables (princ "\nFunction Complete. ") (princ)) ; end function Hi Wizman,
Just tried your LISP, and it returns "NO FUNCTION DEFINITION.... *ERROR* ".
your subroutines dtr, rtd, createlayer and *error* were outside the main function c:tol, include them inside and it should work.
页:
[1]