Force Layer Translation with dws file

[woodman78]

I have this code to process a survey and when I run it the laytrans doesn't run. Does anyone see anything I'm missing or what?

 

 
(defun c:survey_transform ()
; First construct our entity list
(setq vl1 (list
 (cons 0 "LAYER")  ;Name of entity
 (cons 100 "AcDbSymbolTableRecord")     ;Open Records
 (cons 100 "AcDbLayerTableRecord")     ;Locate Layer Table
 (cons 2 "CCC_SURVEY_EXISTING_Feature")    ;Name of Layer
 (cons 6 "Continuous")      ;Linetype
 (cons 62 150)       ;colour = light grey
 (cons 70 0)       ;state
 (cons 290 1)       ;1=plot, 0=Don't plot
  )       ;End of entity list
 )
 (entmake vl1)
(setq vl1 (list
 (cons 0 "LAYER")  ;Name of entity
 (cons 100 "AcDbSymbolTableRecord")     ;Open Records
 (cons 100 "AcDbLayerTableRecord")     ;Locate Layer Table
 (cons 2 "CCC_SURVEY_EXISTING_Number")    ;Name of Layer
 (cons 6 "Continuous")      ;Linetype
 (cons 62 1)       ;colour = light grey
 (cons 70 0)       ;state
 (cons 290 1)       ;1=plot, 0=Don't plot
  )       ;End of entity list
 )
 (entmake vl1)
(setq vl1 (list
 (cons 0 "LAYER")  ;Name of entity
 (cons 100 "AcDbSymbolTableRecord")     ;Open Records
 (cons 100 "AcDbLayerTableRecord")     ;Locate Layer Table
 (cons 2 "CCC_SURVEY_EXISTING_Level")    ;Name of Layer
 (cons 6 "Continuous")      ;Linetype
 (cons 62 84)       ;colour = light grey
 (cons 70 0)       ;state
 (cons 290 1)       ;1=plot, 0=Don't plot
  )       ;End of entity list
 )
 (entmake vl1)
(setq vl1 (list
 (cons 0 "LAYER")  ;Name of entity
 (cons 100 "AcDbSymbolTableRecord")     ;Open Records
 (cons 100 "AcDbLayerTableRecord")     ;Locate Layer Table
 (cons 2 "CCC_SURVEY_Level")     ;Name of Layer
 (cons 6 "Continuous")      ;Linetype
 (cons 62 84)       ;colour = light grey
 (cons 70 0)       ;state
 (cons 290 1)       ;1=plot, 0=Don't plot
  )       ;End of entity list
 )
 (entmake vl1)
(setq vl1 (list
 (cons 0 "LAYER")  ;Name of entity
 (cons 100 "AcDbSymbolTableRecord")     ;Open Records
 (cons 100 "AcDbLayerTableRecord")     ;Locate Layer Table
 (cons 2 "CCC_SURVEY_Number")     ;Name of Layer
 (cons 6 "Continuous")      ;Linetype
 (cons 62 1)       ;colour = light grey
 (cons 70 0)       ;state
 (cons 290 1)       ;1=plot, 0=Don't plot
  )       ;End of entity list
 )
 (entmake vl1)
; First construct our entity list
(setq vl1 (list
 (cons 0 "LAYER")  ;Name of entity
 (cons 100 "AcDbSymbolTableRecord")     ;Open Records
 (cons 100 "AcDbLayerTableRecord")     ;Locate Layer Table
 (cons 2 "CCC_SURVEY_Feature")   ;Name of Layer
 (cons 6 "Continuous")      ;Linetype
 (cons 62 150)       ;colour = light grey
 (cons 70 0)       ;state
 (cons 290 1)       ;1=plot, 0=Don't plot
  )       ;End of entity list
 )
 (entmake vl1)
(and (setq ss (ssget "X" '((8 . "*CODE")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Feature" ""))
(and (setq ss (ssget "X" '((8 . "*ID")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Number" ""))
(and (setq ss (ssget "X" '((8 . "*_Z")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))
(and (setq ss (ssget "X" '((8 . "*Points")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))
(and (setq text1(ssget "x" (list '(0 . "TEXT") (cons 62 70))))
(command "_.CHPROP" TEXT1 "" "_LA" "CCC_SURVEY_Level" ""))
(and (setq text2(ssget "x" (list '(0 . "TEXT") (cons 62 12))))
(command "_.CHPROP" TEXT2 "" "_LA" "CCC_SURVEY_Number" "")) 
(and (setq text3(ssget "x" (list '(0 . "TEXT") (cons 62 152))))
(command "_.CHPROP" TEXT3 "" "_LA" "CCC_SURVEY_Feature" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 70))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Level" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 12))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Number" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 152))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Feature" ""))
(command "_.CHPROP" "all" "" "C" "BYLAYER" "")
(command "_.-layer" "_C" "84" "CCC_SURVEY_Level" "_C" "150" "CCC_SURVEY_Feature" "" )
(acet-laytrans "CCC_Survey.dws" (+ 1 2))
(command "_-purge" "a" "*" "N")
(princ)
)

[BlackBox]

That (your routine) is far more complicated than it needs to be... I wish I had the time now to help with a re-write. Maybe someone else will beat me to it. There is a far simpler way to accomplish these tasks, my friend.

[woodman78]

Can anyone else help so?

[irneb]

Here's one way of doing it. I've seen this exact question so many times I simply decided to make something which works the way I'd have wanted it to:

(vl-load-com)

;;; -------------------------------------------------------------------------------------
;;; Global var to hold last used source drawing
;;; -------------------------------------------------------------------------------------
(setq *ImportLayersFrom* nil)

;;; -------------------------------------------------------------------------------------
;;; Command to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
(defun c:ImportLayers (/ ans fn update import)
 (if (not (setq fn *ImportLayersFrom*))
   (setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
              (getfiled "Select source drawing" (getvar "DWGPREFIX") "dwg" (+ 4 8 16))
              (getstring "\nSource DWG path: ")
            )
   )
 )
 (if (setq fn (findfile fn))
   (progn
     (setq *ImportLayersFrom* fn)
     (princ (strcat "\nLoading from Source: " fn))
     (while (progn
              (princ (strcat "\nExisting layers will"
                             (if update
                               ""
                               " NOT"
                             )
                             " be Updated; Linetypes will"
                             (if import
                               ""
                               " NOT"
                             )
                             " be Improted"
                     )
              )
              (initget "Source Update Import Run Cancel")
              (and (setq ans (getkword "\n[source/Update/Import/Run/Cancel] <Run>: "))
                   (not (wcmatch ans "Run,Cancel"))
              )
            )
       (cond
         ((eq ans "Update") (setq update (not update)))
         ((eq ans "Import") (setq import (not import)))
         ((and (eq ans "Source")
               (setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
                          (getfiled "Select source drawing" (vl-filename-directory fn) "dwg" (+ 4 8 16))
                          (getstring "\nSource DWG path: ")
                        )
               )
          )
          (if (setq fn (findfile fn))
            (setq *ImportLayersFrom* fn)
            (progn
              (print (strcat fn " could not be found."))
              (setq fn *ImportLayersFrom*)
            )
          )
         )
       )
     )
     (if (not (eq ans "Cancel"))
       (ImportLayers fn update import)
     )
   )
 )
 (princ)
)

;;; -------------------------------------------------------------------------------------
;;; Function to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
;;; Arguments:
;;; fn     : File name (incl. path) of source DWG
;;; update : T to change existing layer to match, else nil
;;; ltypes : T to import linetypes if not existing, else nil
;;; -------------------------------------------------------------------------------------
;;; Result : T if done, nil if failed
;;; -------------------------------------------------------------------------------------
(defun ImportLayers (fn update ltypes / dbx1 complete dbxLayers dbxLay Lay val)
 (setq complete nil)
 (if (setq dbx (vla-GetInterfaceObject
                 (vlax-get-acad-object)
                 (strcat "ObjectDBX.AxDbDocument." (itoa (atoi (getvar "ACADVER"))))
               )
     )
   (progn
     (if (not
           (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list dbx 'open fn)))
         )
       (progn
         ;; Ensure all vla objects for current dwg
         (or *acad* (setq *acad* (vlax-get-acad-object)))
         (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
         (or *layers* (setq *layers* (vla-get-Layers *doc*)))
         (or *linetypes* (setq *linetypes* (vla-get-LineTypes *doc*)))

         ;; Step through all layers of source dwg
         (setq dbxLayers (vla-get-Layers dbx))
         (vlax-for dbxLay dbxLayers
           (if (vl-catch-all-error-p
                 (setq Lay (vl-catch-all-apply 'vla-Item (list *layers* (vla-get-Name dbxLay))))
               )
             (setq Lay (vla-Add *layers* (vla-get-Name dbxLay))) ;Create if not existing
             (if (not update)
               (setq Lay nil)
             ) ;Only continue if updating layers as well
           )
           (if Lay
             (progn
               ;; Match description
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Description (list dbxLay))))
                   )
                 (vla-put-Description Lay val)
               )
               ;; Match Plottable
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Plottable (list dbxLay))))
                   )
                 (vla-put-Plottable Lay val)
               )
               ;; Match ViewportDefault
               (if (not
                     (vl-catch-all-error-p
                       (setq val (vl-catch-all-apply 'vla-get-ViewportDefault (list dbxLay)))
                     )
                   )
                 (vla-put-ViewportDefault Lay val)
               )
               ;; Match LineWeight
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineWeight (list dbxLay))))
                   )
                 (vla-put-LineWeight Lay val)
               )
               ;; Match colour
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-TrueColor (list dbxLay))))
                   )
                 (vla-put-TrueColor Lay val)
               )
               ;; Match linetype
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineType (list dbxLay))))
                   )
                 (if (or (tblsearch "LTYPE" val)
                         (and ltypes ;Load linetype if not existing
                              (not (vl-catch-all-error-p
                                     (vl-catch-all-apply
                                       'vla-Load
                                       (list *linetypes*
                                             val
                                             (if (= (getvar "MEASUREMENT") 0)
                                               "acad.lin"
                                               "acadiso.lin"
                                             )
                                       )
                                     )
                                   )
                              )
                         )
                     )
                   (vla-put-LineType Lay val)
                 )
               )
             )
           )
         )
         (setq complete T)
       )
     )
     (vlax-release-object dbx)
   )
 )
 complete
)

The command is ImportLayers.

 

The idea is to match the layers to that of a source DWG/DWT/DWS file. Though you can import by several methods, this way allows you to update existing layers to match as well - similar to the Drawing Standards command, but it can be scripted.

 

If you always have a particular DWG file as the source, then you could modify the (setq *ImportLayersFrom* nil) to set the default source. E.g. if your file is MyTemplate.DWT in folder C:\Myfiles, then it should be:

(setq *ImportLayersFrom* "C:\\Myfiles\\MyTemplate.DWT")

Note double back-slashes!

 

The default is to only import new layers, and not to import linetypes. The Update option toggles updating existing layers on/off, while the Import option does the same for importing linetypes.

 

It "should" work fine for scripting over multiple DWGs as well, but (in such a case) I'd suggest rather using the normal lisp defun thus:

(ImportLayers "C:\\Myfiles\\MyTemplate.DWT" T T)

The last 2 T means Update & Import, if you want them off change the T's to nil's.

[woodman78]

Thanks for the help. That is great.

[Lee Mac]

Maybe this will be of some assistance:

 

http://lee-mac.com/steal.html

[irneb]

Great one Lee. It's actually where I was wanting to take my code, but as usual someone beat me to it! And as usual it was you! Although I think quite a few others had similar code already (I'm sure alan's had something like this for a few years)!

[Lee Mac]

The key is 'CopyObjects', saves you having to match all the properties. :wink:

[irneb]

Thanks yes - that would work nicely for things like block definitions. But what happens when you want to redefine (not just import new) styles / layers?

 

And BTW, I was looking at some way to redefine a linetype direct from DBX. Since there may be a custom linetype which I might not know from which LIN file it came. I can "redefine" a linetype style by modifying the DXF codes, but it's not possible to obtain the DXF codes of the DBX connection's linetype.

 

This particular thing is a nettle in my side for a while now. E.g. we have some projects where inches / mm are mixed between consultants / or even just different portions of the contract. Due to various reasons, I'd have liked to get this away - but can't. Now the inches drawing's linetypes come from ACAD.LIN, while the mm drawings come from ACADISO.LIN (amongst other custom LIN files). And if you xref (say) an inches DWG into a mm DWG the linetypes don't match (and there's no way to modify those XrefName$LinetypeName linetypes through ACad's usual dialogs).

 

There was only 2 potions for this:

 

1. Reload the linetypes inside the inch DWG from the definition files for mm. Save and go to the mm DWG, set VisRetain=0, reload the xref, set VisRetain=1. Go back to the inches DWG and reload the linetypes from the inches definition files. But this is just silly, since you loose any layer settings you made to the xref layers, which could be replaced through some lisp - but the rest can't be done through lisp.
   
2. Have some list of custom linetype names, stating from which file they come. Step through all the xrefed linetypes in the mm DWG and extract the original linetype name, then figure out from the saved list where to reload them from (ACADISO.LIN or some Custom.LIN). Reload all those from that file(s). Get their DXF data, then replace the xref linetypes' DXF data with the same.
   

At least point 2 works reasonably, and if no custom linetypes it's rather simple to do. But worst case is when you don't have the Custom.LIN file available - then neither solution works.

 

EDIT! Scratch that! I just tried! It is possible to use the vlax-vla-object->ename function on a dbx object and from there use entget! :DYippeeeee!!!

[stevesfr]

irneb, I can't seem to import the linetypes from the source dwg. What could I be doing wrong? they all come in as continuous !

TIA, Steve

[irneb]

That's the main problem I was referring to: I.e. my code's only loading/reloading linetypes from the standard set of linetypes. If the source DWG contains any special (custom) linetypes, these will only be placed as Continuous. In this case Lee's code works better, though Lee's doesn't reload/redefine Layers & Linetypes - only imports new.

 

As alluded I've come across a possible fix, but will have to get back on that.

[woodman78]

irneb,

 

I have tried in integrate your code but I can't seem to get it to work. This is what I have. Could you take a look?

(defun c:survey_transform ()

   ; First construct our entity list
   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_EXISTING_Feature")                ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 150)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_EXISTING_Number")                ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 1)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_EXISTING_Level")                ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 84)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_Level")                    ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 84)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_Number")                    ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 1)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)


   ; First construct our entity list
   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_Feature")            ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 150)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

(and (setq ss (ssget "X" '((8 . "*CODE")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Feature" ""))

(and (setq ss (ssget "X" '((8 . "*ID")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Number" ""))

(and (setq ss (ssget "X" '((8 . "*_Z")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))

(and (setq ss (ssget "X" '((8 . "*Points")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))

(and (setq text1(ssget "x" (list '(0 . "TEXT") (cons 62 70))))
   (command "_.CHPROP" TEXT1 "" "_LA" "CCC_SURVEY_Level" ""))

(and (setq text2(ssget "x" (list '(0 . "TEXT") (cons 62 12))))
   (command "_.CHPROP" TEXT2 "" "_LA" "CCC_SURVEY_Number" ""))    

(and (setq text3(ssget "x" (list '(0 . "TEXT") (cons 62 152))))
   (command "_.CHPROP" TEXT3 "" "_LA" "CCC_SURVEY_Feature" ""))

(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 70))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Level" ""))

(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 12))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Number" ""))

(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 152))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Feature" ""))

(command "_.CHPROP" "all" "" "C" "BYLAYER" "")
(command "_.-layer" "_C" "84" "CCC_SURVEY_Level" "_C" "150" "CCC_SURVEY_Feature" "" )

(ImportLayers "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt" T T)

(command "_-purge" "a" "*" "N")

(princ)
)

;;; -------------------------------------------------------------------------------------
;;; Global var to hold last used source drawing
;;; -------------------------------------------------------------------------------------
(setq *ImportLayersFrom* "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt")
;;; -------------------------------------------------------------------------------------
;;; Command to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
(defun ImportLayers (/ ans fn update import)
;(setq *ImportLayersFrom* "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt")
 (if (not (setq fn *ImportLayersFrom*))
   (setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
              (getfiled "Select source drawing" (getvar "DWGPREFIX") "dwg" (+ 4 8 16))
              (getstring "\nSource DWG path: ")
            )
   )
 )
 (if (setq fn (findfile fn))
   (progn
     (setq *ImportLayersFrom* fn)
     (princ (strcat "\nLoading from Source: " fn))
     (while (progn
              (princ (strcat "\nExisting layers will"
                             (if update
                               ""
                               " NOT"
                             )
                             " be Updated; Linetypes will"
                             (if import
                               ""
                               " NOT"
                             )
                             " be Improted"
                     )
              )
              (initget "Source Update Import Run Cancel")
              (and (setq ans (getkword "\n[source/Update/Import/Run/Cancel] <Run>: "))
                   (not (wcmatch ans "Run,Cancel"))
              )
            )
       (cond
         ((eq ans "Update") (setq update (not update)))
         ((eq ans "Import") (setq import (not import)))
         ((and (eq ans "Source")
               (setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
                          (getfiled "Select source drawing" (vl-filename-directory fn) "dwg" (+ 4 8 16))
                          (getstring "\nSource DWG path: ")
                        )
               )
          )
          (if (setq fn (findfile fn))
            (setq *ImportLayersFrom* fn)
            (progn
              (print (strcat fn " could not be found."))
              (setq fn *ImportLayersFrom*)
            )
          )
         )
       )
     )
     (if (not (eq ans "Cancel"))
       (ImportLayers fn update import)
     )
   )
 )
 (princ)
)

;;; -------------------------------------------------------------------------------------
;;; Function to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
;;; Arguments:
;;; fn     : File name (incl. path) of source DWG
;;; update : T to change existing layer to match, else nil
;;; ltypes : T to import linetypes if not existing, else nil
;;; -------------------------------------------------------------------------------------
;;; Result : T if done, nil if failed
;;; -------------------------------------------------------------------------------------
(defun ImportLayers (fn update ltypes / dbx1 complete dbxLayers dbxLay Lay val)
 (setq complete nil)
 (if (setq dbx (vla-GetInterfaceObject
                 (vlax-get-acad-object)
                 (strcat "ObjectDBX.AxDbDocument." (itoa (atoi (getvar "ACADVER"))))
               )
     )
   (progn
     (if (not
           (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list dbx 'open fn)))
         )
       (progn
         ;; Ensure all vla objects for current dwg
         (or *acad* (setq *acad* (vlax-get-acad-object)))
         (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
         (or *layers* (setq *layers* (vla-get-Layers *doc*)))
         (or *linetypes* (setq *linetypes* (vla-get-LineTypes *doc*)))

         ;; Step through all layers of source dwg
         (setq dbxLayers (vla-get-Layers dbx))
         (vlax-for dbxLay dbxLayers
           (if (vl-catch-all-error-p
                 (setq Lay (vl-catch-all-apply 'vla-Item (list *layers* (vla-get-Name dbxLay))))
               )
             (setq Lay (vla-Add *layers* (vla-get-Name dbxLay))) ;Create if not existing
             (if (not update)
               (setq Lay nil)
             ) ;Only continue if updating layers as well
           )
           (if Lay
             (progn
               ;; Match description
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Description (list dbxLay))))
                   )
                 (vla-put-Description Lay val)
               )
               ;; Match Plottable
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Plottable (list dbxLay))))
                   )
                 (vla-put-Plottable Lay val)
               )
               ;; Match ViewportDefault
               (if (not
                     (vl-catch-all-error-p
                       (setq val (vl-catch-all-apply 'vla-get-ViewportDefault (list dbxLay)))
                     )
                   )
                 (vla-put-ViewportDefault Lay val)
               )
               ;; Match LineWeight
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineWeight (list dbxLay))))
                   )
                 (vla-put-LineWeight Lay val)
               )
               ;; Match colour
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-TrueColor (list dbxLay))))
                   )
                 (vla-put-TrueColor Lay val)
               )
               ;; Match linetype
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineType (list dbxLay))))
                   )
                 (if (or (tblsearch "LTYPE" val)
                         (and ltypes ;Load linetype if not existing
                              (not (vl-catch-all-error-p
                                     (vl-catch-all-apply
                                       'vla-Load
                                       (list *linetypes*
                                             val
                                             (if (= (getvar "MEASUREMENT") 0)
                                               "acad.lin"
                                               "acadiso.lin"
                                             )
                                       )
                                     )
                                   )
                              )
                         )
                     )
                   (vla-put-LineType Lay val)
                 )
               )
             )
           )
         )
         (setq complete T)
       )
     )
     (vlax-release-object dbx)
   )
 )
 complete
)

[irneb]

My original code was meant to be a command - not a lisp callable function. So you don't need to have the original c:ImportLayersFrom renamed to ImportLayersFrom - see at the end, that defun's already there. Though this shouldn't cause problems, since the last one should be loaded over the 1st.

 

Can you please state what error message you're getting? And when does this message occur? When loading the lisp or when you run your survey_transform command? Have you tried debugging in VLIDE - I generally step through each line in the lisp to see what's cooking, it's the 2nd thing I do after trying to find the error's position by turning on break on error.

[woodman78]

This is the error I get when I switch the code back to having c:ImportLayersFrom

 

Command: survey_transform
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...

 

And it just keeps going!!!!

[irneb]

Are you performing an autoload? That "Initializing..." message comes from that type of thing. What happens if you simply load the LSP file? Either through (load "Path/LispfileName.LSP") or using AppLoad, or preferably through VLIDE. Nowhere in my code does it have anything showing "Initializing...".

 

I've just tried loading it on mine though VLIDE:

(defun c:survey_transform ()

; First construct our entity list
 (setq vl1 (list
             (cons 0 "LAYER") ;Name of entity
             (cons 100 "AcDbSymbolTableRecord") ;Open Records
             (cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
             (cons 2 "CCC_SURVEY_EXISTING_Feature") ;Name of Layer
             (cons 6 "Continuous") ;Linetype
             (cons 62 150) ;colour = light grey
             (cons 70 0) ;state
             (cons 290 1) ;1=plot, 0=Don't plot
           ) ;End of entity list
 )
 (entmake vl1)

 (setq vl1 (list
             (cons 0 "LAYER") ;Name of entity
             (cons 100 "AcDbSymbolTableRecord") ;Open Records
             (cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
             (cons 2 "CCC_SURVEY_EXISTING_Number") ;Name of Layer
             (cons 6 "Continuous") ;Linetype
             (cons 62 1) ;colour = light grey
             (cons 70 0) ;state
             (cons 290 1) ;1=plot, 0=Don't plot
           ) ;End of entity list
 )
 (entmake vl1)

 (setq vl1 (list
             (cons 0 "LAYER") ;Name of entity
             (cons 100 "AcDbSymbolTableRecord") ;Open Records
             (cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
             (cons 2 "CCC_SURVEY_EXISTING_Level") ;Name of Layer
             (cons 6 "Continuous") ;Linetype
             (cons 62 84) ;colour = light grey
             (cons 70 0) ;state
             (cons 290 1) ;1=plot, 0=Don't plot
           ) ;End of entity list
 )
 (entmake vl1)

 (setq vl1 (list
             (cons 0 "LAYER") ;Name of entity
             (cons 100 "AcDbSymbolTableRecord") ;Open Records
             (cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
             (cons 2 "CCC_SURVEY_Level") ;Name of Layer
             (cons 6 "Continuous") ;Linetype
             (cons 62 84) ;colour = light grey
             (cons 70 0) ;state
             (cons 290 1) ;1=plot, 0=Don't plot
           ) ;End of entity list
 )
 (entmake vl1)

 (setq vl1 (list
             (cons 0 "LAYER") ;Name of entity
             (cons 100 "AcDbSymbolTableRecord") ;Open Records
             (cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
             (cons 2 "CCC_SURVEY_Number") ;Name of Layer
             (cons 6 "Continuous") ;Linetype
             (cons 62 1) ;colour = light grey
             (cons 70 0) ;state
             (cons 290 1) ;1=plot, 0=Don't plot
           ) ;End of entity list
 )
 (entmake vl1)


; First construct our entity list
 (setq vl1 (list
             (cons 0 "LAYER") ;Name of entity
             (cons 100 "AcDbSymbolTableRecord") ;Open Records
             (cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
             (cons 2 "CCC_SURVEY_Feature") ;Name of Layer
             (cons 6 "Continuous") ;Linetype
             (cons 62 150) ;colour = light grey
             (cons 70 0) ;state
             (cons 290 1) ;1=plot, 0=Don't plot
           ) ;End of entity list
 )
 (entmake vl1)

 (and (setq ss (ssget "X" '((8 . "*CODE"))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Feature" "")
 )

 (and (setq ss (ssget "X" '((8 . "*ID"))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Number" "")
 )

 (and (setq ss (ssget "X" '((8 . "*_Z"))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" "")
 )

 (and (setq ss (ssget "X" '((8 . "*Points"))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" "")
 )

 (and (setq text1 (ssget "x" (list '(0 . "TEXT") (cons 62 70))))
      (command "_.CHPROP" TEXT1 "" "_LA" "CCC_SURVEY_Level" "")
 )

 (and (setq text2 (ssget "x" (list '(0 . "TEXT") (cons 62 12))))
      (command "_.CHPROP" TEXT2 "" "_LA" "CCC_SURVEY_Number" "")
 )

 (and (setq text3 (ssget "x" (list '(0 . "TEXT") (cons 62 152))))
      (command "_.CHPROP" TEXT3 "" "_LA" "CCC_SURVEY_Feature" "")
 )

 (and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 70))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Level" "")
 )

 (and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 12))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Number" "")
 )

 (and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 152))))
      (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Feature" "")
 )

 (command "_.CHPROP" "all" "" "C" "BYLAYER" "")
 (command "_.-layer" "_C" "84" "CCC_SURVEY_Level" "_C" "150" "CCC_SURVEY_Feature" "")

 (ImportLayers "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt" T T)

 (command "_-purge" "a" "*" "N")

 (princ)
)

;;; -------------------------------------------------------------------------------------
;;; Global var to hold last used source drawing
;;; -------------------------------------------------------------------------------------
(setq *ImportLayersFrom* "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt")
;;; -------------------------------------------------------------------------------------
;;; Command to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
(defun c:ImportLayers (/ ans fn update import)
;(setq *ImportLayersFrom* "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt")
 (if (not (setq fn *ImportLayersFrom*))
   (setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
              (getfiled "Select source drawing" (getvar "DWGPREFIX") "dwg" (+ 4 8 16))
              (getstring "\nSource DWG path: ")
            )
   )
 )
 (if (setq fn (findfile fn))
   (progn
     (setq *ImportLayersFrom* fn)
     (princ (strcat "\nLoading from Source: " fn))
     (while (progn
              (princ (strcat "\nExisting layers will"
                             (if update
                               ""
                               " NOT"
                             )
                             " be Updated; Linetypes will"
                             (if import
                               ""
                               " NOT"
                             )
                             " be Improted"
                     )
              )
              (initget "Source Update Import Run Cancel")
              (and (setq ans (getkword "\n[source/Update/Import/Run/Cancel] <Run>: "))
                   (not (wcmatch ans "Run,Cancel"))
              )
            )
       (cond
         ((eq ans "Update") (setq update (not update)))
         ((eq ans "Import") (setq import (not import)))
         ((and (eq ans "Source")
               (setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
                          (getfiled "Select source drawing" (vl-filename-directory fn) "dwg" (+ 4 8 16))
                          (getstring "\nSource DWG path: ")
                        )
               )
          )
          (if (setq fn (findfile fn))
            (setq *ImportLayersFrom* fn)
            (progn
              (print (strcat fn " could not be found."))
              (setq fn *ImportLayersFrom*)
            )
          )
         )
       )
     )
     (if (not (eq ans "Cancel"))
       (ImportLayers fn update import)
     )
   )
 )
 (princ)
)

;;; -------------------------------------------------------------------------------------
;;; Function to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
;;; Arguments:
;;; fn     : File name (incl. path) of source DWG
;;; update : T to change existing layer to match, else nil
;;; ltypes : T to import linetypes if not existing, else nil
;;; -------------------------------------------------------------------------------------
;;; Result : T if done, nil if failed
;;; -------------------------------------------------------------------------------------
(defun ImportLayers (fn update ltypes / dbx1 complete dbxLayers dbxLay Lay val)
 (setq complete nil)
 (if (setq dbx (vla-GetInterfaceObject
                 (vlax-get-acad-object)
                 (strcat "ObjectDBX.AxDbDocument." (itoa (atoi (getvar "ACADVER"))))
               )
     )
   (progn
     (if (not
           (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list dbx 'open fn)))
         )
       (progn
         ;; Ensure all vla objects for current dwg
         (or *acad* (setq *acad* (vlax-get-acad-object)))
         (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
         (or *layers* (setq *layers* (vla-get-Layers *doc*)))
         (or *linetypes* (setq *linetypes* (vla-get-LineTypes *doc*)))

         ;; Step through all layers of source dwg
         (setq dbxLayers (vla-get-Layers dbx))
         (vlax-for dbxLay dbxLayers
           (if (vl-catch-all-error-p
                 (setq Lay (vl-catch-all-apply 'vla-Item (list *layers* (vla-get-Name dbxLay))))
               )
             (setq Lay (vla-Add *layers* (vla-get-Name dbxLay))) ;Create if not existing
             (if (not update)
               (setq Lay nil)
             ) ;Only continue if updating layers as well
           )
           (if Lay
             (progn
               ;; Match description
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Description (list dbxLay))))
                   )
                 (vla-put-Description Lay val)
               )
               ;; Match Plottable
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Plottable (list dbxLay))))
                   )
                 (vla-put-Plottable Lay val)
               )
               ;; Match ViewportDefault
               (if (not
                     (vl-catch-all-error-p
                       (setq val (vl-catch-all-apply 'vla-get-ViewportDefault (list dbxLay)))
                     )
                   )
                 (vla-put-ViewportDefault Lay val)
               )
               ;; Match LineWeight
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineWeight (list dbxLay))))
                   )
                 (vla-put-LineWeight Lay val)
               )
               ;; Match colour
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-TrueColor (list dbxLay))))
                   )
                 (vla-put-TrueColor Lay val)
               )
               ;; Match linetype
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineType (list dbxLay))))
                   )
                 (if (or (tblsearch "LTYPE" val)
                         (and ltypes ;Load linetype if not existing
                              (not (vl-catch-all-error-p
                                     (vl-catch-all-apply
                                       'vla-Load
                                       (list *linetypes*
                                             val
                                             (if (= (getvar "MEASUREMENT") 0)
                                               "acad.lin"
                                               "acadiso.lin"
                                             )
                                       )
                                     )
                                   )
                              )
                         )
                     )
                   (vla-put-LineType Lay val)
                 )
               )
             )
           )
         )
         (setq complete T)
       )
     )
     (vlax-release-object dbx)
   )
 )
 complete
)

The message in the Lisp Console is:

; 4 forms loaded from # loading...">

Then after entering your command at ACad's commandline:

Command: survey_transform
_.CHPROP
Select objects: all 162 found
143 were not in current space.
1 was the paper space viewport.

Select objects:
Enter property to change 
[Color/LAyer/LType/ltScale/LWeight/Thickness/Material/Annotative]: C
New color [Truecolor/COlorbook] <BYLAYER>: BYLAYER
Enter property to change 
[Color/LAyer/LType/ltScale/LWeight/Thickness/Material/Annotative]:
Command: _.-layer
Current layer:  "AR-VPORT"
Enter an option 
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: _C
New color [Truecolor/COlorbook] : 84
Enter name list of layer(s) for color 84 <AR-VPORT>: CCC_SURVEY_Level Enter an 
option 
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: _C
New color [Truecolor/COlorbook] : 150
Enter name list of layer(s) for color 150 <AR-VPORT>: CCC_SURVEY_Feature Enter 
an option 
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]:
Command: _-purge
Enter type of unused objects to purge 
[blocks/Dimstyles/LAyers/LTypes/MAterials/Plotstyles/SHapes/textSTyles/Mlinestyl
es/Tablestyles/Visualstyles/Regapps/All]: a Enter name(s) to purge <*>: * 
Verify each name to be purged? [Yes/No] <Y>: N Deleting block "DSA-Arrow".
1 block deleted.
Deleting layer "CCC_SURVEY_EXISTING_Feature".
Deleting layer "CCC_SURVEY_EXISTING_Level".
Deleting layer "CCC_SURVEY_EXISTING_Number".
Deleting layer "CCC_SURVEY_Feature".
Deleting layer "CCC_SURVEY_Level".
Deleting layer "CCC_SURVEY_Number".
6 layers deleted.

No unreferenced linetypes found.
Deleting text style "DIM".
Deleting text style "ROMANS".
2 text styles deleted.

No unreferenced shape files found.
Deleting dimension style "DIM-A".
Deleting dimension style "Standard".
2 dimension styles deleted.

No unreferenced mlinestyles found.

No unreferenced plotstyles found.
Deleting table style "00-NOTESTABLE".
1 table style deleted.

No unreferenced materials found.

No unreferenced visual styles found.

Though it fails since I don't have the DWT in that path.

 

BTW, you don't need the c:ImportLayers defun at all in your code, you could do away with it completely. You're only using the last ImportLayers defun.

[Lee Mac]

That sounds curiously similar to this.

[woodman78]

This is what I have now. I changed the sub-function name to ImportLayers01 after reading LeeMac's link and thought that would solve the problem. When I open a drawing and try to run the lisp from the ribbon i get the Initialising... error but if I do appload and then run it works fine. Any ideas?

 

(defun c:survey_transform ()

   ; First construct our entity list
   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_EXISTING_Feature")                ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 150)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_EXISTING_Number")                ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 1)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_EXISTING_Level")                ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 84)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_Level")                    ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 84)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_Number")                    ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 1)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)


   ; First construct our entity list
   (setq vl1 (list
       (cons 0 "LAYER")        ;Name of entity
       (cons 100 "AcDbSymbolTableRecord")                    ;Open Records
       (cons 100 "AcDbLayerTableRecord")                    ;Locate Layer Table
       (cons 2 "CCC_SURVEY_Feature")            ;Name of Layer
       (cons 6 "Continuous")                        ;Linetype
       (cons 62 150)                            ;colour = light grey
       (cons 70 0)                            ;state
       (cons 290 1)                            ;1=plot, 0=Don't plot
           )                            ;End of entity list
       )
       (entmake vl1)

(and (setq ss (ssget "X" '((8 . "*CODE")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Feature" ""))

(and (setq ss (ssget "X" '((8 . "*ID")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Number" ""))

(and (setq ss (ssget "X" '((8 . "*_Z")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))

(and (setq ss (ssget "X" '((8 . "*Points")))) 
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))

(and (setq text1(ssget "x" (list '(0 . "TEXT") (cons 62 70))))
   (command "_.CHPROP" TEXT1 "" "_LA" "CCC_SURVEY_Level" ""))

(and (setq text2(ssget "x" (list '(0 . "TEXT") (cons 62 12))))
   (command "_.CHPROP" TEXT2 "" "_LA" "CCC_SURVEY_Number" ""))    

(and (setq text3(ssget "x" (list '(0 . "TEXT") (cons 62 152))))
   (command "_.CHPROP" TEXT3 "" "_LA" "CCC_SURVEY_Feature" ""))

(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 70))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Level" ""))

(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 12))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Number" ""))

(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 152))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Feature" ""))

(command "_.CHPROP" "all" "" "C" "BYLAYER" "")
(command "_.-layer" "_C" "84" "CCC_SURVEY_Level" "_C" "150" "CCC_SURVEY_Feature" "" )

(ImportLayers01 "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwg" T T)

(command "_-purge" "a" "*" "N")

(princ)
)




;;; -------------------------------------------------------------------------------------
;;; Function to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
;;; Arguments:
;;; fn     : File name (incl. path) of source DWG
;;; update : T to change existing layer to match, else nil
;;; ltypes : T to import linetypes if not existing, else nil
;;; -----------------------------------------------------------------------------------
;;; Result : T if done, nil if failed
;;; -------------------------------------------------------------------------------------
(defun ImportLayers01 (fn update ltypes / dbx1 complete dbxLayers dbxLay Lay val)
 (setq complete nil)
 (if (setq dbx (vla-GetInterfaceObject
                 (vlax-get-acad-object)
                 (strcat "ObjectDBX.AxDbDocument." (itoa (atoi (getvar "ACADVER"))))
               )
     )
   (progn
     (if (not
           (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list dbx 'open fn)))
         )
       (progn
         ;; Ensure all vla objects for current dwg
         (or *acad* (setq *acad* (vlax-get-acad-object)))
         (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
         (or *layers* (setq *layers* (vla-get-Layers *doc*)))
         (or *linetypes* (setq *linetypes* (vla-get-LineTypes *doc*)))

         ;; Step through all layers of source dwg
         (setq dbxLayers (vla-get-Layers dbx))
         (vlax-for dbxLay dbxLayers
           (if (vl-catch-all-error-p
                 (setq Lay (vl-catch-all-apply 'vla-Item (list *layers* (vla-get-Name dbxLay))))
               )
             (setq Lay (vla-Add *layers* (vla-get-Name dbxLay))) ;Create if not existing
             (if (not update)
               (setq Lay nil)
             ) ;Only continue if updating layers as well
           )
           (if Lay
             (progn
               ;; Match description
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Description (list dbxLay))))
                   )
                 (vla-put-Description Lay val)
               )
               ;; Match Plottable
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Plottable (list dbxLay))))
                   )
                 (vla-put-Plottable Lay val)
               )
               ;; Match ViewportDefault
               (if (not
                     (vl-catch-all-error-p
                       (setq val (vl-catch-all-apply 'vla-get-ViewportDefault (list dbxLay)))
                     )
                   )
                 (vla-put-ViewportDefault Lay val)
               )
               ;; Match LineWeight
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineWeight (list dbxLay))))
                   )
                 (vla-put-LineWeight Lay val)
               )
               ;; Match colour
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-TrueColor (list dbxLay))))
                   )
                 (vla-put-TrueColor Lay val)
               )
               ;; Match linetype
               (if (not
                     (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineType (list dbxLay))))
                   )
                 (if (or (tblsearch "LTYPE" val)
                         (and ltypes ;Load linetype if not existing
                              (not (vl-catch-all-error-p
                                     (vl-catch-all-apply
                                       'vla-Load
                                       (list *linetypes*
                                             val
                                             (if (= (getvar "MEASUREMENT") 0)
                                               "acad.lin"
                                               "acadiso.lin"
                                             )
                                       )
                                     )
                                   )
                              )
                         )
                     )
                   (vla-put-LineType Lay val)
                 )
               )
             )
           )
         )
         (setq complete T)
       )
     )
     (vlax-release-object dbx)
   )
 )
 complete
)

[irneb]

You state the initializing error happens if you use the ribbon. Is the macro in the ribbon simply issuing the survey_transform command? I.e. you've got it set in an autoload somewhere (ACADDOC.LSP / Menu.MNL / etc.)? If so then the link which Lee's pointed to is what's going wrong. If you cannot fix it, then there's some other options which could work:

 

Add a normal (load "LispfileNameAndPath") to your ACADDOC.LSP or menu.MNL. ;or

Add such code into the button's macro. ;or

Add the LSP file into your Startup Suite. ;or....

 

That AutoLoad thingy has some hiccups, e.g. you can't have autoload on a normal lisp function (only lisp commands). And if there's some error in the LSP file or some other error with your setup it loops infinitely with this Initializing bug. For these reasons I've actually re-written autoload for myself - but that's way out of this thread's topic.