Running a function from DCL button causes crash

[jbennett134]

*Disclaimer* I'm not sure where this code came from, it's probably hashed together from several forum posts.

 

I'm working on revising this layer renamer that didn't quite work. I've got the dialog box setup and working fine. I've got the layer renaming functions setup and working fine. The problem is when I try to execute the layer renaming function from the dialog box it crashes.

 

Exception in VEVAL-STR+ ARX Command

Unhandled Exception E06D7363 (e06d7363h) at address FDACB3DDh

 

I think it's getting stuck in a loop because the VLIDE gets stuck until I close the AutoCAD drawing and open a new one. I've simplified the code down for brevity. If any can take a look at it and give some suggestions I'd be very grateful. Thanks in advance!

 

;|------BEGIN---LAYER RENAMER DIALOG BOX---------------------------------------------------------------|;

(defun C:layerRenamer (/ dcl_id fn fname)
 (vl-load-com)
 (create_dialog)
 (setq dcl_id (load_dialog fname))
 (if (not (new_dialog "layerRenamer" dcl_id))
   (exit)
 )					;if

 (action_tile ;This action tile causes a crash when using the UnitLayer function.  It works fine when using the testFunction.
   "btnUnit"
   "(c:unitLayer)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete fname)
 (princ)
)

(defun create_dialog ()
 (setq fname (vl-filename-mktemp "dcl.dcl"))
 (setq fn (open fname "w"))
 (write-line
   "layerRenamer : dialog { 
         label = \"Automated Layer Renaming - V06-08-15\"; 
         : column { 
           : boxed_column { 
             : button {
               key = \"btnUnit\";
               label = \"Fix Standard Unit Layers\";
               is_default = false;
             }
           }
           : boxed_row { 
             : button {
               key = \"cancel\";
               label = \"Close\";
               is_default = true;
               is_cancel = true;
             } 
           }   
         }

}"  fn
 )
 (close fn)
)

;|------END-----LAYER RENAMER DIALOG BOX---------------------------------------------------------------|;

;|------BEGIN---BASIC RENAMING FUNCTION----------------------------------------------------------------|;

(defun c:renameLayer ( oldLayer newLayer / ss i ent )
 (cond ((and (tblsearch "layer" oldLayer) (not (tblsearch "layer" newLayer))) 
 (command "._rename" "la" oldLayer newLayer)
)
((and (tblsearch "layer" oldLayer)(tblsearch "layer" newLayer))
  (setq ss (ssget "x" (list (cons 8 oldLayer))))
  (setq i -1)
   (repeat (sslength ss)
      (setq ent (entget (ssname ss (setq i (1+ i))))
	    ent (subst (cons 8 newLayer) (cons 8 (cdr (assoc 8 ent))) ent)
      )    
      (entmod ent)
          )
)
((not (tblsearch "layer" oldLayer))
  (prompt (strcat "\nLayer " oldLayer " not found. "))
       )
 )
 (princ)
)

;|------END-----BASIC RENAMING FUNCTION----------------------------------------------------------------|;

;|------BEGIN---DRAWING SPECIFIC RENAMING FUNCTIONS----------------------------------------------------|;

(defun c:unitLayer ( / newLayer ) ;This function runs perfectly when run from the command line but crashes when run from dialog box.
 (setq newLayer "1_ANSI")
 (foreach oldLayer '("ANSI" "_ANSI" "F.H." "1_F.H.") (renameLayer oldLayer newLayer))
 (command "._purge" "la" "" "n")
)
 
;|------END-----DRAWING SPECIFIC RENAMING FUNCTIONS----------------------------------------------------|;

(defun c:testFunction ()
 (print "Test Function Ran")
 (princ)
)

[Tharwat]

Remove the c: from the program c:renameLayer and try again .

[jbennett134]

The same error still occurs after removing the c: in the renameLayer function. Thanks for catching that though, I didn't notice it was still set as a command function.

[rkmcswain]

You cannot call the (command) function while a DCL dialog is active.

[Tharwat]

Try this quick modification .

(defun c:Test (/ *error* echo dc fn fname prg)
 (defun *error* (msg)
   (if (and fname (findfile fname))
     (vl-file-delete fname)
   )
   (if echo
     (setvar 'CMDECHO echo)
   )
   (if (and msg
            (not (wcmatch (strcase msg) "*CANCEL*,*BREAK*,*EXIT*"))
       )
     (princ (strcat "\nError =>: " msg "..."))
   )
   (princ)
 )
 (if
   (and
     (setq fname (vl-filename-mktemp "dcl.dcl"))
     (setq fn (open fname "w"))
     (write-line
       "tmp : dialog { label = \"Automated Layer Renaming - V06-08-15\"; 
         : column { 
         : boxed_column { : button { key = \"btnUnit\"; label = \"Fix Standard Unit Layers\"; is_default = false;}}
         : boxed_row { : button { key = \"cancel\"; label = \"Close\"; is_default = true; is_cancel = true;}}}}"
       fn
     )
     (not (close fn))
   )
    (progn
      (if (and (<= 0 (setq dc (load_dialog fname)))
               (new_dialog "tmp" dc)
          )
        (progn (action_tile
                 "btnUnit"
                 "(unitLayer)(setq prg t)(done_dialog)"
               )
               (start_dialog)
               (unload_dialog dc)
               (vl-file-delete fname)
               (if prg
                 (progn
                   (setq echo (getvar 'CMDECHO))
                   (setvar 'CMDECHO 0)
                   (command "._-purge" "la" "" "n")
                   (setvar 'CMDECHO echo)
                 )
               )
        )
        (progn (if (>= dc 0)
                 (unload_dialog dc)
               )
               (if (and fname (setq fname (findfile fname)))
                 (vl-file-delete fname)
               )
        )
      )
    )
 )
 (princ)
)
(defun unitLayer (/ layers newLayer ss i ent)
 (setq layers   (vla-get-layers
                  (vla-get-activedocument (vlax-get-acad-object))
                )
       newLayer "1_ANSI"
 )
 (foreach oldLayer '("ANSI" "_ANSI" "F.H." "1_F.H.")
   (cond ((and (tblsearch "layer" oldLayer)
               (not (tblsearch "layer" newLayer))
          )
          (vla-put-name (vla-item layers oldLayer) newLayer)
         )
         ((and (tblsearch "layer" oldLayer)
               (tblsearch "layer" newLayer)
               (setq ss (ssget "_X" (list (cons 8 oldLayer))))
          )
          (repeat (setq i (sslength ss))
            (setq ent (entget (ssname ss (setq i (1- i))))
                  ent (subst (cons 8 newLayer)
                             (assoc 8 ent)
                             ent
                      )
            )
            (entmod ent)
          )
         )
         ((not (tblsearch "layer" oldLayer))
          (prompt (strcat "\nLayer " oldLayer " not found. "))
         )
   )
 )
 (princ)
)(vl-load-com)

Edited June 12, 2015 by Tharwat

[jbennett134]

That makes sense. I removed the purge command at the end of the unitLayer function.

;(command "._purge" "la" "" "n")

I'm not sure how I'll rename the layers in the renameLayer function.

(command "._rename" "la" oldLayer newLayer)

Can I unload the dialog before the unitLayer function begins so I can use commands?

 

If the function has to run through before the dialog is unloaded then maybe I need to switch from using the command line to using Visual Lisp to rename the layers. I found a thorough discourse on using VLISP and layers at AfraLISP.

[jbennett134]

Thanks for the re-write Tharwat. It runs perfectly. I have to add 7 more layering standards to this script (6 more buttons) and in each standard it's renaming about 20 layers. Is it possible to split this into two functions like I had it before? I'd like to try and work the code out myself based on yours and just want to know if you foresee any issues with it working like that.

[Tharwat]

Thanks for the re-write Tharwat. It runs perfectly.

Nice , happy to hear that . You are most welcome.

 

I have to add 7 more layering standards to this script (6 more buttons) and in each standard it's renaming about 20 layers. Is it possible to split this into two functions like I had it before? I'd like to try and work the code out myself based on yours and just want to know if you foresee any issues with it working like that.

 

Sure you can add as many as you want and just try to work on the codes and if you are in need of any help , just ask and I would do my best to help you with it ( if possible of course).

 

NOTE: I have updated the codes in my last reply and added an error handling with some extra codes to be more accurate.

 

Good luck.

 

Tharwat

[jbennett134]

Okay I'm back and nearly everything is working. I added a function to search through all the blocks in a dwg and to change the layer of any non standard layers but I cannot get it to check blocks that are not inserted into Model Space. I've modified code written by user pbejse on the Autodesk Forum. Any suggestions?

 

(defun FIX1 (BNAM / BENAM)
 (if (not (member BNAM FLST))
   (progn
     (setq FLST  (cons BNAM FLST)
    BENAM (tblobjname "block" BNAM)
     )
     (while (setq BENAM (entnext BENAM))
(setq entLayer (vla-get-layer (vlax-ename->vla-object BENAM)))
(if (= entLayer oldLayer)
  (progn
    (if	(= (cdr (assoc 0 (entget BENAM))) "INSERT")
      (fix1 (cdr (assoc 2 (entget BENAM))))
      (progn
	(setq Ent2change (vlax-ename->vla-object BENAM)
	      blk	 (vla-ObjectIdToObject
			   Dsdwg
			   (vla-get-ownerID Ent2change)
			 )
	)
	(vla-put-layer Ent2change newLayer)
	(vla-get-count blk)
      );end progn
    );end if
  );end progn
);end if
     )
   )
 )
 (princ)
)

(defun C:fxbl (/ ELST ESEL BNAM FLST)
 (vl-load-com)
 (setq Dsdwg (vla-get-activedocument (vlax-get-acad-object)))
 (setq	oldLayer "EL_003"
newLayer "1_ELEV_003"
 )
 (setq SS (ssget "_X" (list (cons 0 "INSERT"))))
 (setq CNTR 0)
 (while (< CNTR (sslength SS))
   (setq ESEL (ssname SS CNTR)
  ELST (entget ESEL)
  BNAM (cdr (assoc 2 ELST))
  FLST nil
   )
   (FIX1 BNAM)
   (setq CNTR (+ CNTR 1))
 )
 
 (vl-cmdf "regen")
 (prin1)
)

[rlx]

(setq ss (ssget "x" (list (cons 0 "insert") (cons 410 (getvar "ctab")) (cons 2 "*TITLEBLOCK*"))))

 

 

replace ctab with name from layout & "*titleblock*" with the name from your block to select a block from a certain layout in paperspace

 

 

gr.Rlx

[jbennett134]

Thanks rlx but I wasn't specific enough in my previous post. I want it to get blocks that are in the blocks table but are not inserted anywhere in the drawing. Maybe I need to look at doing a table search for blocks and see if that returns all blocks. I've noticed it also does not change the layer that nested blocks are inserted on or the layers of lines inside nested blocks.

[rlx]

maybe these links can help you :

 

http://www.cadtutor.net/forum/archive/index.php/t-42464.html

 

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-all-blocks-in-a-drawing/td-p/2648147

 

here you can find a couple of ways to check if a block is referenced or not.

 

and this link : http://www.jtbworld.com/lisp/axblock.htm , see function ax:ExistBlock

 

gr. Rlx