[编程交流] 创建绘图列表，但是

; ** ============[ DwgLst.lsp ]============== **;
; **                                          **;
; **  FUNCTION:                               **;
; **  Will Automatically Create a Drawing     **;
; **  List based on TitleBlock Attribute      **;
; **  Values.                                 **;
; **                                          **;
; ** ======================================== **;
; **                                          **;
; **  SYNTAX: DWGLST                          **;
; **                                          **;
; **  AUTHOR:                                 **;
; **  Copyright (c) 2009, Lee McDonnell       **;
; **  Contact Lee Mac:   CADTutor.net         **;
; **                     TheSwamp.org         **;
; **                                          **;
; ** ======================================== **;
; **                                          **;
; **  RESTRICTIONS:                           **;
; **  Machine must be able to run             **;
; **  Microsoft Excel.                        **;
; **                                          **;
; ** ======================================== **;
; **                                          **;
; **  USAGE:                                  **;
; **  Attributes from every instance of a     **;
; **  Specified Block are Extracted to        **;
; **  Excel.                                  **;
; **                                          **;
; **  An Excel file may be selected or        **;
; **  upon the user hitting Cancel at         **;
; **  the prompt, a new Excel file is         **;
; **  created.                                **;
; **                                          **;
; ** ======================================== **;
; **                                          **;
; **  VERSION:                                **;
; **  1.0  ~  01.07.2009                      **;
; **                                          **;
; ** ======================================== **;
; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= ;
(defun c:DwgLst  (/ *error* ss cAtt attlst
                   oLst xlApp file xlshe
                   UCells xlCells Col row
                   blkName ValLst)
 
 (vl-load-com)
 (defun *error* (msg)
   (mapcar 'ObjRel
     (list xlApp xlShe UCells xlCells))
   (if
     (not
       (wcmatch
         (strcase msg)
           "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat
         "\n<< Error: " msg " >>"))
     (princ "\n*Cancel*"))
   (princ))
 (setq blkName "titleblock")
 (setq ValLst '("NAME" "DATE" "NUMBER"))
 
 (if (setq ss
       (ssget "_X"
         (list (cons 0 "INSERT")
               (cons 2 blkName) (cons 66 1))))         
   (progn
     (foreach Obj
       (mapcar 'vlax-ename->vla-object
         (mapcar 'cadr (ssnamex ss)))
     (foreach Att
       (append
         (vlax-safearray->list
           (vlax-variant-value
             (vla-GetAttributes Obj)))
         (if
           (not
             (vl-catch-all-error-p
               (setq cAtt
                 (vl-catch-all-apply
                   'vlax-safearray->list
                     (list
                       (vlax-variant-value
                         (vla-getConstantAttributes Obj)))))))
           cAtt))
       (if (vl-position
             (strcase
               (vla-get-TagString Att)) ValLst)
         (setq attlst
           (cons
             (cons
               (vla-get-TagString Att)
                 (vla-get-TextString Att)) attlst))))
       (setq olst
         (cons
           (vl-sort attlst
             (function
               (lambda (a b)
                 (< (car a) (car b))))) olst) attlst nil))
     (if (setq file (getfiled "Select Excel File" "" "xls" )
       (progn
         (setq xlApp (vlax-get-or-create-object "Excel.Application")
               xlshe (vlax-get-property
                       (vlax-get
                         (vla-open
                           (vlax-get xlApp "Workbooks")
                           file)
                         "Sheets")
                       "Item" 1)
               Ucells  (vlax-get xlshe "Usedrange")
               xlCells (vlax-get xlshe "Cells"))
         (setq Col (- (vlax-get
                        (vlax-get ucells "Columns")
                        "Count")
                      2)
               row     (1+
                         (vlax-get
                           (vlax-get ucells "Rows")
                           "Count"))))
       (progn
         (setq xlApp (vlax-get-or-create-object "Excel.Application")
               xlshe (vlax-get-property
                       (vlax-get
                         (vlax-invoke-method
                           (vlax-get xlApp "Workbooks")
                           "Add")
                         "Sheets")
                       "Item" 1)
               xlCells (vlax-get xlshe "Cells") Col 1 row 1)))
     (vla-put-visible xlApp :vlax-true)
     (foreach Sht (reverse oLst)
       (if (< 65536 row)
         (setq Col 4))
       (vlax-put-property xlCells "Item"
         row Col (cdaddr Sht))
         (vlax-put-property xlCells "Item"
           row (1+ Col) (cdar Sht))
           (vlax-put-property xlCells "Item"
             row (+ Col 2) (cdadr Sht))
       (setq row (1+ row)))
     (mapcar 'ObjRel
       (list xlApp xlShe UCells xlCells))
     (gc) (gc)
     (alert "Close Excel File Manually"))
   (princ "\n<< No TitleBlocks Found in Drawing >>"))
 (princ))
(defun ObjRel (Obj)
 (and Obj
   (eq 'VLA-OBJECT (type Obj))
     (not (vlax-object-released-p Obj))
       (vl-catch-all-apply
         'vlax-release-object
           (list Obj))))
(vl-load-com)
(princ
 (vl-list->string
   '(10 42 42 32 68 119 103 76 115 116 46 108 115 112 32 98
     121 32 76 101 101 32 77 99 68 111 110 110 101 108 108
     44 32 67 111 112 121 114 105 103 104 116 32 169 32 74
     117 108 121 32 50 48 48 57 32 42 42 10 32 32 32 32 32
     32 32 32 32 32 32 32 45 32 84 121 112 101 32 34 68 87
     71 76 83 84 34 32 116 111 32 73 110 118 111 107 101 32 45)))
(princ)
;|
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;
                         End of Program Code                          
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;
|;