怎么在PU清理时保留原有ACAD.DWT模版里已经设定好的图层

alin

下面是我平时用的图层输入输出程序，可以从另外的图档的图层选择性或全部输入当前图档。也可以把图层输出。本人比较懒，喜欢用DosLib，这个也不例外，需要加载，到http://download.rhino3d.com/McNeel/1.0/doslib/下载。


(defun c:IMPLAY (/    objarray  dwgName   dbxdoc  dbxLayers
   adoc    cnt      count     dbxLayer  newpath
  )
  (vl-load-com)
  (IF (NULL (getenv "IMPTPATH"))
    (setenv "IMPTPATH" "c:/extras/templates")
  )
  (IF
    (setq dwgName
    (dos_getfiled
      "Select a file"
      (getenv "IMPTPATH")
      "Drawing files (*.dwg)|*.dwg|Drawing Template files (*.dwt)|*.dwt|All files (*.*)|*.*||"
    )
    )
     (PROGN
       (setq newpath (vl-filename-directory dwgName))
       (setq dbxDoc (vla-GetInterfaceObject
        (vlax-get-acad-object)
        (STRCAT "ObjectDBX.AxDbDocument."
         (SUBSTR (GETVAR "ACADVER") 1 2)
        )
      )
       )
       (vlax-invoke dbxDoc "Open" dwgName)
       (setq dbxLayers (vla-get-Layers dbxDoc)
      adoc      (vla-get-activedocument (vlax-get-acad-object))
      count     (vla-get-count dbxLayers)
      cnt       0
      layerLst  '()
       )
       (repeat count
  (setq
    layerLst (cons (vla-get-name (vla-item dbxLayers cnt))
     layerLst
      )
  )
  (setq cnt (1+ cnt))
       )
       (SETQ layerlst (vl-sort layerlst '<))
       (if (setq rtnlst (dos_multilist
     "Import Layers"
     "Select layers"
     layerLst
     '(0)
   )
    )
  (progn
    (foreach lay rtnlst
      (setq dbxLayer (vla-item dbxLayers lay))
      (setq objArray
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbObject '(0 . 0))
        (list dbxLayer)
      )
      )
      (vla-CopyObjects
        dbxDoc
        objArray
        (vla-get-Layers adoc)
        idpairs
      )
    ) ; foreach
    (princ
      (strcat "\n* Layers imported from file [" dwgname "] *")
    )
  ) ;progn
  (princ "\nNo layer(s) imported. Function cancelled.")
       ) ; end if
       (vlax-release-object dbxDoc)
       ;;(alert (strcat "Layers Imported from " dwgname))
       (setenv "IMPTPATH" newpath)
       (setq dbxDoc nil
      dwgname nil
       )
     )
  )
  (princ)
)

(defun c:EXPLAY (/    objarray  dbxLayers dwgName  tmpName
   adoc    cnt      count     dbxLayer  newpath
  )
  (vl-load-com)
  (princ
    "\nSelect layers to export...Enter to select from layer list"
  )
  (if (setq ss (ssget))
    (progn
      (setq idx 0
     layerlst '()
      )
      (repeat (sslength ss)
(setq layerlst (cons (cdr (assoc 8 (entget (ssname ss idx))))
        layerlst
         )
)
(setq idx (1+ idx))
      )
    ) ;
    (setq layerlst (dos_layerlistbox
       "AutoCAD Layers"
       "Select one or more layers to export"
       (+ 128 256)
     )
    )
  )
  (IF (NULL (getenv "IMPTPATH"))
    (setenv "IMPTPATH" "c:/extras/templates")
  )
  (IF
    (setq dwgName
    (dos_getfiled
      "Select a file"
      (getenv "IMPTPATH")
      "Drawing files (*.dwg)|*.dwg|Drawing Template files (*.dwt)|*.dwt|All files (*.*)|*.*||"
    )
    )
     (PROGN
       (setq newpath (vl-filename-directory dwgName))
       (setq dbxDoc (vla-GetInterfaceObject
        (vlax-get-acad-object)
        (STRCAT "ObjectDBX.AxDbDocument."
         (SUBSTR (GETVAR "ACADVER") 1 2)
        )
      )
       )
       (vlax-invoke dbxDoc "Open" dwgName)
       (setq dbxLayers (vla-get-Layers dbxDoc)
      adoc      (vla-get-activedocument (vlax-get-acad-object))
       )
       (foreach lay layerlst
  (setq aLayer (vla-item (vla-get-layers adoc) lay))
  (setq objArray
  (vlax-safearray-fill
    (vlax-make-safearray vlax-vbObject '(0 . 0))
    (list aLayer)
  )
  )
  (vla-CopyObjects
    adoc
    objArray
    dbxLayers
    idpairs
  )
       ) ; foreach
       (vla-saveas
  dbxDoc
  (setq tmpname
  (strcat (vl-filename-directory dwgName) "\\TEMP.dwg")
  )
  nil
       )
       (vlax-release-object dbxDoc)
       (princ
  (strcat "\n* Layers exported to file [" dwgname "] *")
       )
       (setenv "IMPTPATH" newpath)
       (DOS_DELETE dwgName)
       (dos_rename tmpname dwgName)
       (setq dbxDoc nil
      dwgname nil
       )
     ) ; PROGN
  ) ; END IF
  (princ)
)

淡泊高远1990

mandala 发表于 2011-6-30 09:31
介绍一个实用的办法：
新建一个空的dwg，把这些图层加入后保存。写一个pu.lsp，在pu之后插入这个dwg。

什么意思呀 没听懂

淡泊高远1990

669423907 发表于 2011-6-30 12:50
大师写的有条有里，我却看得云里雾里！

我也是 听不懂哦