清理archi的Lisp例程
我需要一个lisp例程的帮助来清理建筑师的绘图。解锁、解冻并打开所有层
爆发
将所有图层更改为bylayer
将所有图案填充更改为254色并发送到背面
将所有线宽更改为0.18
全部更改为颜色8
过度杀戮
净化 几个问题
图层设置为“bylayer”还是“所有对象”也设置为“bylayer”？如果全部按层设置，则将线宽设置为与颜色相同的更改层设置的一部分。
(defun allbylayer ( / x obj ssall)
(setq ssall (ssget "x"))
(repeat (setq x(sslength ssall))
(setq obj (vlax-ename->vla-object (ssname ssall (setq x (- x 1)))))
(vlax-put-property obj "Linetype" "Bylayer")
(vlax-put-property obj "Lineweight" " -1")
(vlax-put-property obj "Color" acbylayer)
)
)
(allbylayer)
(Alert "All objects now by layer")
; open database
(setqdoc (vla-get-activedocument(vlax-get-acad-object)))
(setq lays (vla-get-Layers doc))
(vlax-for lay lays
(vla-put-color lay
(vla-put-lineweight lay 18) ; note 18 for metric =0.18 not tested on feet dwg must match a known size.
)
Burst在与lisp一起使用时有一个别名。但这是可行的
(while (setq ss (ssget "X" ))
(sssetfirst nil ss)
(C:Burst)
)
清除使用
(command "-purge" "all" "*" "n")
过度杀戮帮助任何人 我可以使用LISP，在建筑师开始绘制图纸之前对其进行处理 谢谢，比格尔会试一试，让你知道它是怎么回事！ BIGAL是的，所有层都更改为bylayer&所有层都更改为颜色8，还有将图案填充设置为254并设置为back的乐趣吗？ 谢谢，比格尔会试一试，让你知道它是怎么回事！
BIGAL是的，所有层都更改为bylayer&所有层都更改为颜色8，还有将图案填充设置为254并设置为back的乐趣吗？ 可以对其进行修改以满足您的需要。 谢谢你能给我发个lsp让我试试吗？
这是一个开始：
解锁、解冻并打开所有层
爆发
将所有图层更改为bylayer假设这是bylayer的所有对象
将所有图案填充更改为254色并发送到背面
将所有线宽更改为0.18
全部更改为颜色8
过度杀戮
净化
(defun c:drawingtobylayer
;;-----------------------------------------------------------------
;;
;;Copyright © 2004 Michael Puckett. All Rights Reserved
;;
;;-----------------------------------------------------------------
;;
;;Forces the entire drawing to "ByLayer" (even xrefs for
;;the lifetime of the session or until an xref reload
;;occurs).
;;
;;Forces block definition child entities to layer "0".
;;
;;Existing attributes are forced to the same layer the
;;parent block reside on.
;;
;;Nominally tested, let me know if you find anything wonky.
;;
;;* Use at your own risk. Please test on a dummy dwg *
;;
;;-----------------------------------------------------------------
(/ _unlockalllayers _locklayers _objecttolayerzero _objecttobylayer _documenttobylayer _main)
;; (idt_draworder (idt_ss->vla-list (ssget)) 'movetobottom)
(defun _unlockalllayers (document / result)
(vlax-for layer (vlax-get-property document 'layers)
(cond ((eq :vlax-true (vlax-get-property layer 'lock))
(vlax-put-property layer 'lock :vlax-false)
(setq result (cons layer result))
)
)
;; RJP added: Change all layers to color 8, linewight to 18mm, thaw and turn on
(foreach property '((color .(lineweight . 18) (freeze . 0) (layeron . -1))
(vl-catch-all-apply 'vlax-put (list layer (car property) (cdr property)))
)
)
result
)
(vlax-ename->vla-object (tblobjname "layer" "0"))
(defun _locklayers (layers) (foreach layer layers (vlax-put-property layer 'lock :vlax-true)))
;; (defun _objecttolayerzero (object) (vlax-put-property object 'layer "0"))
(defun _objecttobylayer (obj / layer)
;; RJP added lineweight and transparency
(foreach property '((color . 256)
(linetype . "ByLayer")
(lineweight . "ByLayer")
(transparency . "ByLayer")
)
(vl-catch-all-apply 'vlax-put (list obj (car property) (cdr property)))
)
(cond ((and (eq "AcDbBlockReference" (vlax-get obj 'objectname))
(eq :vlax-true (vlax-get-property obj 'hasattributes))
)
(setq layer (vlax-get-property obj 'layer))
(foreach child (vlax-invoke obj 'getattributes)
(_objecttobylayer child)
(vlax-put-property child 'layer layer)
)
)
;; RJP added hatch to color 254
((eq "AcDbHatch" (vlax-get obj 'objectname))
(vl-catch-all-apply 'vla-put-color (list obj 254))
)
)
)
(defun _documenttobylayer (document)
(vlax-for block (vlax-get-property document 'blocks)
(if (eq :vlax-true (vlax-get-property block 'islayout))
(vlax-for object block (_objecttobylayer object))
(vlax-for object block (_objecttobylayer object))
)
)
)
(defun _main (/ document lockedlayers)
(setq lockedlayers
(_unlockalllayers
(setq document (vlax-get-property (vlax-get-acad-object) 'activedocument))
)
)
(_documenttobylayer document)
;; RJP leave layers unlocked
;; (_locklayers lockedlayers)
(princ)
)
(_main)
)
谢谢Ronjonp会试试的！
页:
[1]
2