[编程交流] 读取autocad文件

(defun c:test ( / doc file lst )
 (if
   (and
     (setq file (getfiled "Select Drawing" "" "dwg;dwt;dws" 16))
     (setq doc  (LM:GetDocumentObject (vlax-get-acad-object) file))
   )
   (progn
     (vlax-for l (vla-get-layers doc) (setq lst (cons (vla-get-name l) lst)))
     (vlax-release-object doc)
   )
 )
 (reverse lst)
)        
;;-----------------=={ Get Document Object }==----------------;;
;;                                                            ;;
;;  Retrieves a the VLA Document Object for the specified     ;;
;;  filename. Document Object may be present in the Documents ;;
;;  collection, or obtained through ObjectDBX                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  acapp    - AutoCAD Application Object                     ;;
;;  filename - filename for which to retrieve document object ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Document Object, else nil                   ;;
;;------------------------------------------------------------;;
(defun LM:GetDocumentObject ( acapp filename / acdocs dbx )
 
 (vlax-for doc  (vla-get-Documents acapp)
   (setq acdocs (cons (cons (strcase (vla-get-fullname doc)) doc) acdocs))
 )
 (cond
   ( (not (setq filename (findfile filename)))
     nil
   )
   ( (cdr (assoc (strcase filename) acdocs))
   )
   ( (not
       (vl-catch-all-error-p
         (vl-catch-all-apply 'vla-open
           (list (setq dbx (LM:ObjectDBXDocument acapp)) filename)
         )
       )
     )
     dbx
   )
 )
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  acapp - AutoCAD Application Object                        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA ObjectDBX Document object, else nil         ;;
;;------------------------------------------------------------;;
(defun LM:ObjectDBXDocument ( acapp / acver )
 (vla-GetInterfaceObject acapp
   (if (< (setq acver (atoi (getvar "ACADVER"))) 16)
     "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acver))
   )
 )
)
(vl-load-com) (princ)

 
(defun c:test ( / doc file )
 (if
   (and
     (setq file (getfiled "Select Drawing" "" "dwg;dwt;dws" 16))
     (setq doc  (GetDocumentObject (vlax-get-acad-object) file))
   )
   (progn
     (setq LayerTable (vla-get-layers doc))
     (setq aNewLayer (vla-add LayerTable "TestLayer"))
     (vla-put-color aNewLayer 2)
     (vlax-release-object doc)
   )
 )
 (reverse lst)
) 

;;-----------------=={ Get Document Object }==----------------;;
;;                                                            ;;
;;  Retrieves a the VLA Document Object for the specified     ;;
;;  filename. Document Object may be present in the Documents ;;
;;  collection, or obtained through ObjectDBX                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  acapp    - AutoCAD Application Object                     ;;
;;  filename - filename for which to retrieve document object ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Document Object, else nil                   ;;
;;------------------------------------------------------------;;

 
(vla-save doc)

 
(setq thisdrawing 
     (vla-get-activedocument 
          (vlax-get-acad-object)))
(vla-save thisdrawing )

(defun c:test ( / doc file )
 (if
   (and
     (setq file (getfiled "Select Drawing" "" "dwg;dwt;dws" 16))
     (setq doc  (LM:GetDocumentObject (vlax-get-acad-object) file))
   )
   (progn
     (setq layer (vla-add (vla-get-layers doc) "TestLayer"))
     (vla-put-color layer 2)
     (vla-saveas doc file)
     (vlax-release-object doc)
   )
 )
 (princ)
)