[编程交流] d使用lisp“减重”

  (defun DwgWblock (dwgfileLst /   ACADAPP    BACKUPFILE
     BASENAME   DOCOBJ   DWGNAME    FILEPATH
     INDEX      NEWSET   SSETS
    )
   (setq AcadApp (vlax-get-acad-object))
   (repeat (setq Index (length dwgfileLst))
     (setq DwgName (nth (setq Index (1- Index)) dwgfileLst))
     (setq BaseName   (vl-filename-base DwgName)
    filepath   (vl-filename-directory DwgName)
    ;;dxfFile    (vl-string-subst ".dxf" ".dwg" DwgName)
    BackupFile (strcat (getfullpath filepath)
         BaseName
         "_Backup"
         (vl-filename-extension DwgName)
        )
     )
     (if (findfile BackupFile)
(deletefile BackupFile)
     )     
     (if (vl-file-rename DwgName BackupFile) 
(progn
  (setq
    DocObj (vla-open (vla-get-documents AcadApp) BackupFile)
  )
  (setq ssets (vla-get-selectionsets DocObj))
  (if (vl-catch-all-error-p
 (vl-catch-all-apply 'vla-item (list ssets "$$Set"))
      )
    (setq newSet (vla-add ssets "$$Set"))
    (progn
      (vla-delete (vla-item ssets "$$Set"))
      (setq newSet (vla-add ssets "$$Set"))
    )
  )
  ;;select all objects in the drawing
  (vla-Select newSet acSelectionSetAll)
  (vla-WBlock DocObj DwgName newSet)
  (vla-close DocObj :vlax-false)
  (deletefile BackupFile)
)
     )
   )
   (if DocObj
     (vlax-release-object DocObj)
   )
   (if AcadApp
     (vlax-release-object AcadApp)
   )
 )
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun DwgWblock1 (HasOpenFiles / *ACAD* *DOCS* DWGNAME N)
   (setq *ACAD* (vlax-get-acad-object))
   (setq HasOpenFiles (mapcar 'strcase HasOpenFiles))
   (vlax-for item (vla-get-Documents *ACAD*)
     (if (member (strcase (vlax-get-property item 'FullName))
   HasOpenFiles
  )
(vla-close item :vlax-false)
     )
   )
   (DwgWblock HasOpenFiles)
   (setq *DOCS* (vla-get-documents *ACAD*))
   (repeat (setq n (length HasOpenFiles)) 
     (setq DwgName (nth (setq n (1- n)) HasOpenFiles))
     (vla-open *DOCS* DwgName)
   )
 )