[编程交流] 层生成器Lisp例程Iss

(vl-load-com)
(defun BB:CSV->Layers (path / f *error* _extract _trim acDoc l layerTable
                      layerName layerItem layerDescription layerColor
                      layerLinetype layerLineweight layerPlottable
                      layerFreeze
                     )
 ;; Exampe: (BB:CSV->Layers "Z:\\my_layers_folder\\my_layers.csv")
 (if (and (findfile path)
          (setq f (open path "r"))
     )
   (progn
     ;; Error handler
     (defun *error* (msg)
       (vla-endundomark acDoc)
       (cond
         ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
       )                                                               
       (if f
         (close f)
       )
       (princ)
     )
     ;; Line _extraction sub-function
     (defun _extract (l /)
       (substr l 1 (vl-string-search "," l))
     )
     ;; Line _trim sub-function
     (defun _trim (v /)
       (vl-string-subst "" (strcat v ",") l)
     )
     ;; Main code
     (vla-startundomark
       (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
     )
     (read-line f)                                                     ; <- Skip first line (headers)
     (setq layerTable (vla-get-layers acDoc))
     ;; Linetype check
     ;; <- Add linetype import code here, to avoid errors
     (while (/= nil (setq l (read-line f)))
       (progn
         ;; Layer check
         (setq layerItem
                (vla-add layerTable (setq layerName (_extract l)))
         )
         ;; Layer settings          
         (setq l (_trim layerName))
         (vla-put-description
           layerItem
           (setq layerDescription (_extract l))
         )
         (setq l (_trim layerDescription))
         (if (/= 7 (setq layerColor (_extract l)))
           (vla-put-color layerItem layerColor)
         )
         (setq l (_trim layerColor))
         (vla-put-linetype layerItem (setq layerLinetype (_extract l)))
         (setq l (_trim layerLinetype))
         (if
           (= "BYLAYER" (strcase (setq layerLineweight (_extract l))))
            (vla-put-lineweight layerItem aclnwtbylayer)
         )
         (setq l (_trim layerLineweight))
         (if (/= "YES" (strcase (setq layerPlottable (_extract l))))
           (vla-put-plottable layerItem :vlax-false)
         )
         (setq l (_trim layerPlottable))
         (if (/= "NO " (strcase (setq layerFreeze (_extract l))))
           (vla-put-freeze layerItem :vlax-true)
         )
       )
     )
     (setq f (close f))
     (*error* nil)
   )
 )
)

(RM:CSV->Layers "Z:\\my_layers_folder\\my_layers.csv")

(defun AT:ImportLayers (dwg / _catch col odbx odbxcol)
 ;; Import layers from specified drawing file
 ;; Alan J. Thompson
 (defun _catch (fnc lst / c)
   (if (not (vl-catch-all-error-p (setq c (vl-catch-all-apply fnc lst))))
     (cond (c)
           (T)
     )
   )
 )
 (or *Acad* (setq *Acad* (vlax-get-acad-object)))
 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument *Acad*)))
 (if (and (setq dwg (findfile dwg))
          (setq col (vla-get-layers *AcadDoc*))
          (setq odbx
                 (_catch
                   'vla-GetInterfaceObject
                   (list *Acad* (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'ACADVER) 1 2)))
                 )
          )
          (_catch 'vla-open (list odbx dwg))
     )
   (vlax-for obj (setq odbxcol (vla-get-layers odbx))
     (_catch 'vla-CopyObjects
             (list odbx
                   (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 0)) (list obj))
                   col
             )
     )
   )
 )
 (mapcar (function (lambda (o) (and o (_catch 'vlax-release-object o)))) (list odbxcol odbx))
)