层生成器Lisp例程Iss
大家好，我发现了这个lisp rountine，它将图层从加载到AutoCad中。csv文件。它在大多数情况下都很好用，但当我使用“冻结”栏时，它挂了。我正在发布lisp和csv文件。只需记住更改csv文件在lisp中的位置。谢谢你的帮助。
图层创建器。拉链 是否尝试将图形的图层列表提取到。csv文件？
塔瓦特 不，我要走另一条路。从csv文件到cadd。 查看open、while、read line和vla put-*函数。
在ACAD 2009中工作良好
在图层选项板上调用“冻结”时，Autocad崩溃？
哎呀，现在我知道你说的“冻结列”是什么意思了，CSV文件中的列
那么你到底想在那里发生什么？你想在装货时冷冻几层吗？ 看起来他正在使用CSV文件创建图层和图层设置/信息。含糖的
是的，我也有同样的问题，当我编辑csv文件中的冻结列时，它会挂起。不知道为什么会这样。希望有人能解决这个问题。我想用这个。我还可以看到解冻柱。我喜欢这样的事实，即如果文件中的现有层被修改，它将覆盖这些层。
-如果你只有一把锤子，一切看起来都像钉子。 也许这会有所帮助（代码编写得很快）：
(vl-load-com)
(defun BB:CSV->Layers (path / f *error* _extract _trim acDoc l layerTable
layerName layerItem layerDescription layerColor
layerLinetype layerLineweight layerPlottable
layerFreeze
)
;; Exampe: (BB:CSV->Layers "Z:\\my_layers_folder\\my_layers.csv")
(if (and (findfile path)
(setq f (open path "r"))
)
(progn
;; Error handler
(defun *error* (msg)
(vla-endundomark acDoc)
(cond
((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(if f
(close f)
)
(princ)
)
;; Line _extraction sub-function
(defun _extract (l /)
(substr l 1 (vl-string-search "," l))
)
;; Line _trim sub-function
(defun _trim (v /)
(vl-string-subst "" (strcat v ",") l)
)
;; Main code
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(read-line f) ; <- Skip first line (headers)
(setq layerTable (vla-get-layers acDoc))
;; Linetype check
;; <- Add linetype import code here, to avoid errors
(while (/= nil (setq l (read-line f)))
(progn
;; Layer check
(setq layerItem
(vla-add layerTable (setq layerName (_extract l)))
)
;; Layer settings
(setq l (_trim layerName))
(vla-put-description
layerItem
(setq layerDescription (_extract l))
)
(setq l (_trim layerDescription))
(if (/= 7 (setq layerColor (_extract l)))
(vla-put-color layerItem layerColor)
)
(setq l (_trim layerColor))
(vla-put-linetype layerItem (setq layerLinetype (_extract l)))
(setq l (_trim layerLinetype))
(if
(= "BYLAYER" (strcase (setq layerLineweight (_extract l))))
(vla-put-lineweight layerItem aclnwtbylayer)
)
(setq l (_trim layerLineweight))
(if (/= "YES" (strcase (setq layerPlottable (_extract l))))
(vla-put-plottable layerItem :vlax-false)
)
(setq l (_trim layerPlottable))
(if (/= "NO " (strcase (setq layerFreeze (_extract l))))
(vla-put-freeze layerItem :vlax-true)
)
)
)
(setq f (close f))
(*error* nil)
)
)
)
基本上，这允许您指定任何。CSV文件（格式相同），并快速导入*这些*层。您可以为每个规程设置一个宏（假设它们使用不同的层），或者为每个客户端设置一个宏。。。无论什么这实际上取决于你如何工作，以及你的需求是什么。
如果这有帮助的话，我可以很容易地将例程修改为“硬编码”，如果这是唯一的。您需要的CSV文件。
希望这有帮助！ 如果你走另一条路。。。
http://lee-mac.com/layerextract.html
ODBX从现有图形文件导入。。。
(RM:CSV->Layers "Z:\\my_layers_folder\\my_layers.csv")
eg。
(defun AT:ImportLayers (dwg / _catch col odbx odbxcol)
;; Import layers from specified drawing file
;; Alan J. Thompson
(defun _catch (fnc lst / c)
(if (not (vl-catch-all-error-p (setq c (vl-catch-all-apply fnc lst))))
(cond (c)
(T)
)
)
)
(or *Acad* (setq *Acad* (vlax-get-acad-object)))
(or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument *Acad*)))
(if (and (setq dwg (findfile dwg))
(setq col (vla-get-layers *AcadDoc*))
(setq odbx
(_catch
'vla-GetInterfaceObject
(list *Acad* (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'ACADVER) 1 2)))
)
)
(_catch 'vla-open (list odbx dwg))
)
(vlax-for obj (setq odbxcol (vla-get-layers odbx))
(_catch 'vla-CopyObjects
(list odbx
(vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 0)) (list obj))
col
)
)
)
)
(mapcar (function (lambda (o) (and o (_catch 'vlax-release-object o)))) (list odbxcol odbx))
) 美好的
页:
[1]
2