Jump to content

Problem with variable restoration


woodman78

Recommended Posts

Hi all,

 

I have a lisp that I am sure someone here helped with but it was the early days of my lisp journey and I never noted the source. Anyway, the variable are not restoring on completion. Can someone have a look for me?

 

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:BG ()
 (POPUP_MF)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun POPUP_MF (/ SIZE$ SIZE SUCE SUCL SUOM  SUSM SUAB SUAD MIDPT PLEN
                  PT01  PT02 a b COLR)
 (setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))
 (setq temperr *error*)
 (setq *error* ETRAP_BG)
 (setq S1_list
  '("Proposed 180 PE 4 A" "Proposed 180 PE 4 B"
    "Proposed 150 PE 19 A" "Proposed 150 PE 19 B"
     "Proposed 125 PE 4 A"  "Proposed 125 PE 4 B"
     "Proposed 90 PE 4 A"  "Proposed 90 PE 4 B"
     "Proposed 63 PE 4 A"  "Proposed 63 PE 4 B"
     "--------------------------"
     "Existing 180 PE 4"  "Existing 150 PE 19"
     "Existing 125 PE 4"  "Existing 90 PE 4"
     "Existing 63 PE 4"
   )
 )
 (setq dcl_id (load_dialog "BG.dcl"))
 (if
   (not
     (new_dialog "BG" dcl_id)
   )
   (progn
     (ALERT "Can not find your dcl file")
     (exit)
   )
 )
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if SIZE:DEF
   (set_tile "S1" (itoa SIZE:DEF))
 )
 (action_tile "cancel"
  "(done_dialog)(setq userclick nil)"
 )
 (action_tile "accept"
   (strcat
    "(progn
     (setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (VARIABLE_BG)
 )
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Variable Function
;
(defun VARIABLE_BG ()
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$ "Proposed 180 PE 4 A")(setq SIZE$ "Proposed_Gas_180PE4A")(setq LTYP "180P4A")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 180 PE 4 B")(setq SIZE$ "Proposed_Gas_180PE4B")(setq LTYP "180P4B")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 150 PE 19 A")(setq SIZE$ "Proposed_Gas_150PE19A")(setq LTYP "150P19A")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 150 PE 19 B")(setq SIZE$ "Proposed_Gas_150PE19B")(setq LTYP "150P19B")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 125 PE 4 A")(setq SIZE$  "Proposed_Gas_125PE4A")(setq LTYP "125P4A")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 125 PE 4 B")(setq SIZE$  "Proposed_Gas_125PE4B")(setq LTYP "125P4B")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 90 PE 4 A")(setq SIZE$  "Proposed_Gas_90PE4A")(setq LTYP "90P4A")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 90 PE 4 B")(setq SIZE$  "Proposed_Gas_90PE4B")(setq LTYP "90P4B")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 63 PE 4 A")(setq SIZE$  "Proposed_Gas_63PE4A")(setq LTYP "63P4A")(setq COLR "177,12,228"))
     ((= SIZE$ "Proposed 63 PE 4 B")(setq SIZE$  "Proposed_Gas_63PE4B")(setq LTYP "63P4B")(setq COLR "177,12,228"))
     ((= SIZE$ "Existing 180 PE 4")(setq SIZE$  "Existing_Gas_180PE4")(setq LTYP "180E4")(setq COLR "204,81,5"))
     ((= SIZE$ "Existing 150 PE 19")(setq SIZE$  "Existing_Gas_150PE19")(setq LTYP "150E19")(setq COLR "204,81,5"))
     ((= SIZE$ "Existing 125 PE 4")(setq SIZE$  "Existing_Gas_125PE4")(setq LTYP "125E4")(setq COLR "204,81,5"))
     ((= SIZE$ "Existing 90 PE 4")(setq SIZE$  "Existing_Gas_90PE4")(setq LTYP "90E4")(setq COLR "204,81,5"))
     ((= SIZE$ "Existing 63 PE 4")(setq SIZE$  "Existing_Gas_63PE4")(setq LTYP "63E4")(setq COLR "204,81,5"))
   )
 )
 (setq SIZE SIZE$) 
 (OUTPUT_BG)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Output Function
;
(defun OUTPUT_BG ()
 (setq a (strcat "CCC_BG_"LTYP)
       b (strcat "CCC_SERVICES_"SIZE)
 )
 (if
   (not
     (tblsearch "LTYPE" a)
   )
   (command "_.-linetype" "_l" a "CCC_Gas.lin" "")
 )
 (command "_.-layer" "_N" b "_M" b "_L" a b "_C" "_T" COLR b "_LW" "0.3" b "" )
 (command "_-color"  "bylayer")
 (command "._-linetype"  "s"  "bylayer" "")
 (setvar "cmdecho" 0)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (setvar "plinegen" 0)
 (command "._pline")
 (BG_RESTORE)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Restore User Settings Function.
;
(defun BG_RESTORE ()
 (setq *error* TERR$)
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nProgram completed and will now restore the user settings and exit.")
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Error Trap Function
;
(defun ETRAP_BG (errmsg)
 (command nil nil nil)
 (if
   (not
     (member errmsg '("console break" "Function Cancelled"))
   )
   (princ (strcat "\nError:" errmsg))
 )
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "clayer"    SUCL)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ "\nError, Restoring Variables.")
 (terpri)
 (setq *error* temperr)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////

 

Thanks.

Link to comment
Share on other sites

Of course woodman, because you never define SUS and SUS_LIST.

What restore your variables (if SUS (mapcar 'setvar SUS_LIST SUS)) start by checking if the "SUS" variable exist, which does not.

 

You have to set your variables in a compatible way with your restauration...

You might want to check the buzzard reply in one your own thread... http://www.cadtutor.net/forum/showthread.php?53521-What-s-if-the-user-pressed-CANCEL-while-running-a-lisp&p=362769&viewfull=1#post362769

 

that i found googling your restauration mapcar "(mapcar 'setvar SUS_LIST SUS))"..

 

Cheers

Link to comment
Share on other sites

Jef! I have used that method on other routines to do the same thing but the restoration does not work. Here is the lisp with Buzzards code:

 

 

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:PRWMDIA (/ HOLE$ SIZE$ HOLE SIZE PT01 PT02 a b lw DEGREES RADIANS)
 (PRWMDIA_SAVE)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Save User Settings Function.
;
(defun PRWMDIA_SAVE (/ SUS SUCE SUOM SUSM SUAB SUAD SUCL SUCR)
 (setq SUS_LIST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "snapang" "textsize" "textstyle" "angbase" "angdir")
       SUS      (mapcar 'getvar SUS_LIST)
       TERR *error*
      *error* PRWMDIA_RESTORE)
 (PRWMDIA_MF)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun PRWMDIA_MF ()
 (setq T1_list '("Type A" "Type B"))
 (setq S1_list '( "300mm" "250mm" "200mm" "150mm" "100mm"))
 (setq dcl_id (load_dialog "PRWMDIA.dcl"))
 (if (not (new_dialog "PRWMDIA" dcl_id))
   (progn (ALERT "Can not find your dcl file")
     (exit)))
 (start_list "T1")
 (mapcar 'add_list T1_list)
 (end_list)
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if HOLE:DEF (set_tile "T1" (itoa HOLE:DEF)))
 (if SIZE:DEF (set_tile "S1" (itoa SIZE:DEF)))
 (action_tile "cancel" "(done_dialog)(setq userclick nil)")
 (action_tile "accept"
   (strcat
    "(progn
     (setq H:OLE (atoi (get_tile \"T1\")) HOLE:DEF H:OLE)"
    "(setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"))
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (PRWMDIA_VARIABLE))
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PRWMDIA_VARIABLE Function
;
(defun PRWMDIA_VARIABLE ()
 (progn
   (setq HOLE$ (fix H:OLE))
   (setq HOLE$ (nth H:OLE T1_list))
   (cond
     ((= HOLE$ "Type A"))
     ((= HOLE$ "Type B"))))
 (setq HOLE HOLE$)
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$  "300mm")(setq SIZE$  "300D"))
     ((= SIZE$  "250mm")(setq SIZE$  "250D"))
     ((= SIZE$  "200mm")(setq SIZE$  "200D"))
     ((= SIZE$  "150mm")(setq SIZE$  "150D"))
     ((= SIZE$  "100mm")(setq SIZE$  "100D"))))
 (setq SIZE SIZE$) 
 (PRWMDIA_OUTPUT)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PRWMDIA_OUTPUT Function
;
(defun PRWMDIA_OUTPUT ()
 (if (null (tblsearch "STYLE" "CCC_Services"))
   (entmake
     (list
       (cons 0 "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2 "CCC_Services")
       (cons 3 "Verdana.ttf")
       (cons 40 0)
       (cons 70 0))))
 (setq a  (strcat "CCC_WM_"SIZE"_"HOLE)
       b  (strcat "CCC_SERVICES_Proposed_Watermain_Ductile_Iron_"SIZE"_"HOLE)
       lw 30)
 (if (null (tblsearch "LTYPE" a))
   (command "_.-linetype" "_l" a "CCC_Watermain_DI.lin" ""))
 (if (null (tblsearch "LAYER" b))
 (command "_.-layer" "_N" b "_M" b "_L" a b "_C" "30" b "_LW" "0.3" b "" ))
 (command "_-color"  "bylayer")
 (command "._-linetype"  "s"  "bylayer" "")    
 (setvar "cmdecho" 0)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (command "_.-layer" "_S" b "")
 (setvar "plinegen" 1)
 (command "._pline")
 ;(PRWMDIA_RESTORE)
(setvar "clayer" SUCL)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun PRWMDIA_DTR (DEGREES)
(* pi (/ DEGREES 180.0)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun PRWMDIA_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Restore User Settings Function.
;
(defun PRWMDIA_RESTORE ()
 (setq *error* TERR)
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nProgram completed and will now restore the user settings and exit.")
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Error Trap Function.
;
(defun PRWMDIA_ETRAP (ERRORMSG)
 (command nil nil nil)
 (if (not (member ERRORMSG '("console break" "Function cancelled")))
   (princ (strcat "\nError:" ERRORMSG)))
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nAttention!....A user error has occurred.")
 (princ "\nThe program will now restore the user settings and exit.")
 (terpri)
 (setq *error* TERR)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////

 

Can you help me to figure out why the restoration doesn't work.

Link to comment
Share on other sites

This is another routine that I have:

 

(defun c:LegendBatch (/ laylist SUCE SUOM SUSM SUAB SUAD SUCL SUCR)
 
(setq SUCE (getvar "cmdecho"))
(setq SUOM (getvar "orthomode"))
(setq SUSM (getvar "osmode"))
(setq SUAB (getvar "angbase"))
(setq SUAD (getvar "angdir"))
(setq SUCL (getvar "clayer"))
(setq SUCR (getvar "cecolor"))

 (command "_.-layer" "_M" "CCC_SHEET_LAYOUT_Legend" "_C" "7" "CCC_SHEET_LAYOUT_Legend" "_LW" "0.3" "CCC_SHEET_LAYOUT_Legend" "" )

 (command "_-color"  "bylayer")

(setq laylist '(
;***************Existing Road Items******************
("CCC_LAYOUT_Existing_River_Hatch" "Existing river hatch")
("CCC_LAYOUT_Existing_Roads_Hatch" "Existing roads")
("CCC_LAYOUT_Existing_Footpath_Hatch" "Existing Footpath")
)
)
(foreach l laylist
(if (and (tblsearch "LAYER" (car l))
          (setq n (findfile (strcat (cadr l) ".dwg")))
     )
  (command "_.-INSERT" n "_s" "1" "_r" "0" "\\")
 )
)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "clayer" SUCL)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "cecolor"    SUCR)
(princ))

 

Can someone tell me why the variables aren't being restored? What am I not getting?

Link to comment
Share on other sites

I have been playing with this all morning to try to get it to work but no joy. This is another routine I have and as far as I can see I have followed the way to restoring the variables correctly but it will not restore the layer to the setting prior to running the routine. Can it be due to the way in which the variables are declared?

 

(defun c:insertnotes (/ *error* DCHANDLE INPT OV PT RTN S1_LIST VL SUSM SUCL)

 (setq SUSM (getvar "osmode"))
 (setq SUCL (getvar "clayer"))

 (defun *error* (msg)
   (and dcHandle (unload_dialog dcHandle))
   (and ov (mapcar 'setvar vl ov))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq S1_list
  '("*** General Notes ***" 												;0
    "All dimensions in metres unless otherwise stated" 									;1
    "All dimensions in millimetres unless otherwise stated" 									;2
    "Any queries to be conveyed to the CCC Road Design Office..." 								;3
    "Any queries omissions or discrepancies to be conveyed to RDO..."							;4
    "Dimensions not to be scaled from drawing. Any queries to be conveyed to the CCC RDO..." 					;5
    "The information on this plan is a general guide and the accuracy thereof cannot be guaranteed.  No liability is accepted..." 		;6
    "Diversion of existing river and placing of precast concrete culverts will be permitted only in the months of May to October..."		;7
    "--------------------------------------"											;8
    "*** Surveying ***"     												;9  					
    "All levels are related to Ordnance Datum at Malin Head"								;10
    "All levels are relative to Cork County Council local datum as detailed by CCC RDO"						;11
    "All X Eastings Y Northings are relative to Irish National Grid (ING) coordinate system"					;12
    "All X Eastings Y Northings are relative to Irish Transverse Mercator (ITM) coordinate system"					;13
    "All X Eastings Y Northings are relative to Cork County Council local grid as detailed by CCC RDO"                                         		;14
    "All X Eastings Y Northings and Z Levels and contours are in metres"							;15
    "All X Eastings Y Northings and Z Levels are in metres"									;16
    "All coordinates are related to a local Cork County Council grid as detailed by CCC RDO"					;17
    "All survey control points are marked on the ground using a Survey Point nail"						;18
    "This topo survey was carried out in DATE"										;19
    "This topo survey was carried out between DATE and DATE"								;20	
    "This survey information is intended for the sole use of Cork County Council..."						;21
    "--------------------------------------"											;22
    "*** Signs & Lining ***"     											;23
    "TSM refers to Traffic Signs Manual"											;24  
    "Advanced stop lines and approach cycle lane details from Provision of Cycle Facilities - National Manual for Urban Areas..."	;	25
    "All road markings are white in colour unless stated otherwise"								;26
    "All signs to have a minimum headroom clearence of 2.5m as indicated in figure 3.1 of Provision of Cycle Facilities..."		;27
    "All yield road marking triangles on cycle track are to be half the size of the dimensions stated in figure 7.2 of TSM"			;28
    "Cycle track markings to be in accordance with Provision of Cycle Facilities - National Manual for Urban Areas & TSM"		;29
    "Lane indication arrows are to be installed in accordance with figure 7.24 7.25 of TSM"					;30
    "The location of all signs and road markings to be agreed onsite with the Engineer prior to installation"				;31	
    "--------------------------------------"											;32
    "*** Tactile Paving & Kerbing***" 											;33
    "The dimples or blisters on the tactile paving units shall be aligned so as to guide visually impaired pedestrians directly to..." 	;34
    "Tactile Paving details from Guidance on Use of Tactile Paving Surfaces published by the Dept on the Env & Trans UK..."		;35
    "Maximum projection of dropped kerbs at tactile paving locations to be 6mm above carriageway level"				;36
    "The location of tactile paving and assocaited dropped kerbs are to be agreed with the RDO prior to installation"			;37
    "Tactile Paving to extend across full width of dropped kerbs"								;38
    "--------------------------------------"											;39
    "*** Pedestrian Notes ***" 											;40
    "Controlled pedestrian crossings to be constructed as per TMG (2003) and include red tactile slabs..."				;41
    "Uncontrolled pedestrian crossings to be constructed as per TMG (2003) and include grey or buff tactile slabs..." 			;42
    "--------------------------------------"											;43
    "*** Watermain Notes ***"  											;44
    "All blockwork and brickwork used in the construction of valve or hydrant chambers to have min comp strength of 20Nmm2..."	;45
    "All mortar used for valve or hydrant chamber construction to have a minimum compressive strength of 20Nmm2"  			;46
    "All sluice valves to be right hand closing and to be fitted with extension spindles"						;47
    "Chamber size for sluice valves hydrants and air valves to be 675mm square internal 1105mm square external" 			;48
    "Floor slab depth to be a minimum of 200mm deep with concrete class C30 20"						;49
    "All watermain covers are to D400 traffic loading specification" 								;50
    "Watermain marker tape 300mm above the crown of the watermain"							;51
    "All valve spindles are brought up to within 50mm of the underside of the chamber cover by using extension spindles"		;52
    "Watermain chambers are to be constructed from blockwork"								;53
    "New ductile iron watermain can only connect to the existing asbestos watermain..."						;54
    "--------------------------------------"											;55
    "*** Reinforced Concrete Notes ***" 										;56
    "All concrete to be grade 35A. Minimum size of aggregate to be 20mm"							;57
    "All steel to be checked and approved by Engineer prior to pouring"							;58
    "All steel to be Type 2 deformed grade 460Nmm2"									;59
    "Cutting and bending to be in accordnace with BS8666..."								;60
    "EF - Earth Face FF - Far Face..."											;61
    "Minimum cover to steel to be 50mm"										;62
    "Minimum lap length to be 38 times BAR diameter"									;63
    "--------------------------------------"											;64
    "*** Public Lighting ***" 												;65
    "Feeder duct from main line to be provided. Concrete pipe to be slotted for cable connection"					;66
    "--------------------------------------"											;67
    "*** Traffic Signals ***" 												;68
    "All traffic signal pole positions to be agreed on site with the engineer prior to placing"					;69
   )
 )

 (setq vl '("CMDECHO" "CLAYER" "OSMODE") ov (mapcar 'getvar vl))
 (setvar "attdia" 1)
 (cond (  (<= (setq dcHandle (load_dialog "insertnotes.dcl")) 0)

          (princ "\n** Dialog file not Found **"))

       (  (not (new_dialog "insertnotes" dcHandle))

          (princ "\n** Dialog Definition Not Found **"))

       (t

          (start_list "S1")
          (mapcar (function add_list) S1_list)
          (end_list)

          (set_tile "S1" (setq *def* (cond (*def*) ("1"))))

          (action_tile "S1"     "(setq *def* $value)")
        
          (action_tile "accept" "(cond ((member (atoi *def*) '(0 8 9 22 23 32 33 39 40 43 44 55 56 64 65 67 68)) (alert \"Invalid Note\"))
                                       ((done_dialog 1)))")
        
          (action_tile "cancel" "(done_dialog 0)")

          (setq rtn (start_dialog))

          (setq dcHandle (unload_dialog dcHandle))

          (if (= 1 rtn)
            (progn

              (or (tblsearch "LAYER" "CCC_SHEET_LAYOUT_Notes")
                  (entmake (list (cons 0 "LAYER")
                                 (cons 100 "AcDbSymbolTableRecord")
                                 (cons 100 "AcDbLayerTableRecord")
                                 (cons 2 "CCC_SHEET_LAYOUT_Notes")
                                 (cons 70 0)
                                 (cons 62 7)
                                 (cons 370 30))))
;(vla-put-description (vlax-ename->vla-object (tblobjname "LAYER" "CCC_SHEET_LAYOUT_Notes")) "My description for Lay1")

              ;(mapcar 'setvar vl '(0 "CCC_SHEET_LAYOUT_Notes" 0))

(setvar "clayer" "CCC_SHEET_LAYOUT_Notes")

              (foreach block (mapcar
                               (function
                                 (lambda (x) (nth x S1_list)))

                               (read (strcat "(" *def* ")")))
                (setvar "osmode" 1)
(command "_.-INSERT" block "_s" "1" "_r" "0" "\\")))
	 	
            (princ "\n*Cancel*"))))
(setvar "osmode" SUSM)
(setvar "attdia" 0)
(setvar "clayer" SUCL)
 (mapcar 'setvar vl ov)

(princ))

Link to comment
Share on other sites

This is another routine that I have:

 

(defun c:LegendBatch (/ laylist SUCE SUOM SUSM SUAB SUAD SUCL SUCR)
 
(setq SUCE (getvar "cmdecho"))
(setq SUOM (getvar "orthomode"))
(setq SUSM (getvar "osmode"))
(setq SUAB (getvar "angbase"))
(setq SUAD (getvar "angdir"))
(setq SUCL (getvar "clayer"))
(setq SUCR (getvar "cecolor"))

 (command "_.-layer" "_M" "CCC_SHEET_LAYOUT_Legend" "_C" "7" "CCC_SHEET_LAYOUT_Legend" "_LW" "0.3" "CCC_SHEET_LAYOUT_Legend" "" )

 (command "_-color"  "bylayer")

(setq laylist '(
;***************Existing Road Items******************
("CCC_LAYOUT_Existing_River_Hatch" "Existing river hatch")
("CCC_LAYOUT_Existing_Roads_Hatch" "Existing roads")
("CCC_LAYOUT_Existing_Footpath_Hatch" "Existing Footpath")
)
)
(foreach l laylist
(if (and (tblsearch "LAYER" (car l))
          (setq n (findfile (strcat (cadr l) ".dwg")))
     )
  (command "_.-INSERT" n "_s" "1" "_r" "0" "\\")
 )
)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "clayer" SUCL)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "cecolor"    SUCR)
(princ))

 

Can someone tell me why the variables aren't being restored? What am I not getting?

 

The system variables are not being restored because that segment of code is not being reached; perhaps due to an *error*?

 

Give this a try:

 

(defun c:LegendBatch (/ *error* angbase angdir cecolor clayer cmdecho
                     orthomode osmode dwgName dwgPath
                    )

 (defun *error* (msg)

   ;; restore system variables
   (and angbase (setvar 'angbase angbase))                             ;<-- not used
   (and angdir (setvar 'angdir angdir))                                ;<-- not used
   (and cecolor (setvar 'cecolor cecolor))
   (and clayer (setvar 'clayer clayer))
   (and cmdecho (setvar 'cmdecho cmdecho))                             ;<-- not used
   (and orthomode (setvar 'orthomode orthomode))                       ;<-- not used
   (and osmode (setvar 'osmode osmode))                                ;<-- not used

   ;; end undo
   (command "._undo" "_e")

   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
   )
   (princ)
 )

 ;; start undo
 (command "._undo" "_e" "._undo" "_be")

 ;; store system variables
 (setq angbase (getvar 'angbase))                                      ;<-- not used
 (setq angdir (getvar 'angdir))                                        ;<-- not used
 (setq cecolor (getvar 'cecolor))
 (setq clayer (getvar 'clayer))
 (setq cmdecho (getvar 'cmdecho))                                      ;<-- not used
 (setq orthomode (getvar 'orthomode))                                  ;<-- not used
 (setq osmode (getvar 'osmode))                                        ;<-- not used

 ;; set system variables
 (setvar 'cecolor "bylayer")

 ;; make new layer
 (command "._-layer" "_m" "CCC_SHEET_LAYOUT_Legend" "_lw" "0.3"
          "CCC_SHEET_LAYOUT_Legend" ""
         )

 ;; insert blocks
 (foreach item
          '(
            ;; *************** Existing Road Items ******************
            ("CCC_LAYOUT_Existing_River_Hatch" . "Existing river hatch")
            ("CCC_LAYOUT_Existing_Roads_Hatch" . "Existing roads")
            ("CCC_LAYOUT_Existing_Footpath_Hatch" . "Existing Footpath")
           )
   (if (tblsearch "layer" (car item))
     (if
       (setq dwgPath
              (findfile (setq dwgName (strcat (cdr item) ".dwg")))
       )
        (command "._-insert" dwgPath "_s" "1" "_r" "0" "\\")
        (prompt (strcat "\n** \"" dwgName "\" cannot be found ** "))
     )
   )
 )

 (*error* nil)
)

Link to comment
Share on other sites

Here are my thougths.. in your code

 

(setq SUS_LIST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "snapang" "textsize" "textstyle" "angbase" "angdir")

SUS (mapcar 'getvar SUS_LIST)

TERR *error*

*error* PRWMDIA_RESTORE)

 

prwmdia_restore is a funtions.

  (setq SUS_LIST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "snapang" "textsize" "textstyle" "angbase" "angdir")
       SUS      (mapcar 'getvar SUS_LIST)
       TERR *error*
      *error* [color="red"]([/color]PRWMDIA_RESTORE[color="red"])[/color])

 

After that I added a division by 0 in the main function to trigger an error, and it seemed to work as I got your error message to be displayed (Program completed and will now restore the user settings and exit.bad function: ). I'm far from beeing an expert in error handling error handling tho.

 

I hope it will help you resolve your issue.

Cheers

Link to comment
Share on other sites

Here is what I use. No need for a restore function.

 

Code is by Elpanov Evgenyi.

 

;;; Error Handler by ElpanovEvgenyi                                       ;
   (defun *error* (msg)
(mapcar 'eval varl) ; this line restore all your variables
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
          (princ (strcat "\nError: " msg))
       )
(and *AcadDoc* (vla-endundomark *AcadDoc*))
       (princ)
   )
    
   (setq varl '("CLAYER" "OSMODE" "CMDECHO" "DIMZIN" ); Put whichever variables your program uses here
         varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
   )     

 

On completion of program, use:

 

(*error* nil)

Link to comment
Share on other sites

I tend to use something like:

(defun c:yourcommand ( / *error* val var )

   (defun *error* ( msg )
       (mapcar 'setvar var val)
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (setq var '(cmdecho osmode clayer)
         val  (mapcar 'getvar var)
   )

   ; ... do your thing ...

   (mapcar 'setvar var val)
   (princ)
)

Link to comment
Share on other sites

Lee,

 

Essentially, It boils down to the same thing.

 

With your way, there is also do no need for a separate restore function.

 

ymg

Link to comment
Share on other sites

That can easily be said for your code as well :), as your post also contains a call to restore sysvars (as it should) - error handling isn't new, just often unused, or simly used improperly when unfamiliar, YMMV.

 

Cheers

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...