[编程交流] 从DCL bu运行函数

;|------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)
)

(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)

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

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