读取autocad文件
大家好，我只想在不打开的情况下读取autocad文件的图层列表。
用lisp可以吗？
谢谢
库马尔。 这可以通过ObjectDBX实现，如下代码所示：
(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)
)
添加图层后，需要保存文件。
为什么现在变成了：？
什么是“如何窃取别人的想法，为自己赢得全部荣誉？”
http://foggyd.files.wordpress.com/2011/02/ken.jpg
呜呜，呜呜，呜呜。正确答案是“什么是笨蛋？”
对不起伙计们
我不想把这归功于我。
作为向一个非常新鲜的人解释它的一部分，我刚刚删除了它，以证明我们可以为函数使用任何名称。不幸的是，我复制了那个。
下面的标题仍然在我的原始程序中。
同时感谢李的快速帮助。
;;-----------------=={ 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 ;;
;;------------------------------------------------------------;;
也许我的幽默尝试有点尖锐。
不过我想你明白，那些为他人的利益自愿工作的人（也就是说，免费工作），只是想得到应得的荣誉。没什么了。
现在你知道了。。。知道是：
http://devcentral.f5.com/weblogs/images/devcentral_f5_com/weblogs/macvittie/WindowsLiveWriter/sBusinessOperationalg_98BB/knowing_2.png 大家好，
在向文档添加图层后，我尝试使用
(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)
)
使用ObjectDBX时，需要使用SaveAs方法。 谢谢李
它工作得很好。。。。。。
页:
[1]