社区 › Auto Lisp › 寻找Lisp例程

tzframpton 发表于 2022-7-6 07:43:38

寻找Lisp例程

谁有一个例程可以抓取所有块，并将块内的内容设置为逐层的颜色？有时我会绘制一些图，比如说，有150个门作为块，但有75个不同的门名称，所以我经常使用QSELECT和explode，高亮显示所有，然后按层设置颜色。只是看看是否有一个Lisp例程可以做到这一点。。。。
 
虽然我不确定这是否/如何工作，但因为标准的方法是使用REFEDIT。不管怎样，只要看看有没有人拥有的东西。我们将不胜感激。提前感谢

DANIEL 发表于 2022-7-6 07:47:12

听起来你需要标准化你的区块

tzframpton 发表于 2022-7-6 07:52:00

不是我的街区。。。这些是建筑师的图纸眨眼：

Guest Alan Cull 发表于 2022-7-6 07:54:01

别再说了，伙计。。。。。。。
 
建筑师！！！！！对不起，各位建筑师。。。。。
 
Styk。。。。。再多告诉我一点。。。。我也许能帮上忙。。。。。？？？

tzframpton 发表于 2022-7-6 07:57:57

艾伦，你没有被捆绑！！很高兴你回来。。。
 
嗯，基本上我想要的是：一个例程，选择图形中的所有块，并将颜色更改为“按层”。不是块本身，而是块内的内容。这可以通过Lisp实现吗？编辑：我试图摆脱所有的障碍，这就是为什么我问一个程序可以做这样的事情。

VVA 发表于 2022-7-6 08:02:06

试试看

;;published by kpblc
;;http://www.arcada.com.ua/forum/viewtopic.php?t=526
(defun c:normblocks (/ adoc answer lays lock lay *error* ans0 atype cnt)
(defun *error* (msg)(princ msg)
(if lock (foreach x lock (vla-put-lock x :vlax-true)))(vl-cmdf "_.Redraw"))
(vl-load-com)(setq cnt 0)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq lays (vla-get-layers adoc))
(vla-startundomark adoc)
(initget "LType LWeight Color All _ T W C A")
(if (null (setq answer
   (getkword "\nIn blocks to lead to norm <All> : ")))
   (setq answer "A")) ;_ end of if
(initget "byLayer byBlock")
(setq atype (getkword "\nSet contents inside the block to <byBlock>:"))
(initget "Yes No")
(setq ans0 (getkword "\nChange entities layer's to 0? <No>:"))
(vlax-for item (vla-get-blocks adoc)
   (if   (not (wcmatch (strcase (vla-get-name item) t) "*_space*"))
   (progn
   (setq cnt (1+ cnt))
   (grtext -1 (strcat "Modyfied " (vla-get-name item)))
(vlax-for   sub_item (vla-item (vla-get-blocks adoc) (vla-get-name item))
(setq lay (vla-item lays (vla-get-layer sub_item)))
(if (= (vla-get-lock lay) :vlax-true)
(progn (vla-put-lock lay :vlax-false)(setq lock (cons lay lock))))
(if (= ans0 "Yes")(vla-put-Layer sub_item "0"))
(cond
    ((= answer "W")
   (vla-put-LineWeight sub_item (if (= atype "byLayer") acLnWtByLayer aclnwtbyblock))
   )
    ((= answer "T")
   (vla-put-linetype sub_item (if (= atype "byLayer") "ByLayer" "ByBlock"))
   )
    ((= answer "C")
   (vla-put-color sub_item (if (= atype "byLayer") acByLayer acByBlock))
   )
    (t
   (vla-put-LineWeight sub_item (if (= atype "byLayer") acLnWtByLayer aclnwtbyblock))
   (vla-put-linetype sub_item (if (= atype "byLayer") "ByLayer" "ByBlock"))      
   (vla-put-color sub_item (if (= atype "byLayer") acByLayer acByBlock))
   )
    ) ;_ end of cond
) ;_ end of vlax-for
)
   ) ;_ end of if
   ) ;_ end of vlax-for
(if lock (foreach x lock (vla-put-lock x :vlax-true)))
(vla-regen adoc acallviewports)
(vla-endundomark adoc)(vl-cmdf "_.Redraw")
(princ (strcat"\nModyfied " (itoa cnt) " blocks"))
(princ)
) ;_ end of defun

tzframpton 发表于 2022-7-6 08:04:07

VVA，我想说你就是那个男人！！工作完美。。。。哇，这节省了很多时间。它甚至有更多选项，例如将所有内容设置为第0层。
 
非常感谢！！我注意到它是由kpblc写的，在这个论坛上。。。如果他是作者的话，我非常感谢他。
 

VVA 发表于 2022-7-6 08:08:52

是的，它的开始是由Alexey（kpblc）提出的。我只有一点进步。
***已添加***
在我看来，所有国家的建筑师都是一样的。这个程序是为更改他们的图纸而编写的

Guest Alan Cull 发表于 2022-7-6 08:10:57

嘿Styk。。。。。。。你肯定很快得到了你想要的回复。。。好的
 
VVA。。。我对建筑师没有意见，我哥哥和嫂子都是建筑师。。。。。所以我不认为这是对他们的。
 
然而他们确实让我们人民的生活更加艰难。。。。

Paraglide1 发表于 2022-7-6 08:13:33

我在这里为您（免费）准备了一个例程：
http://paracadd.com
查找BLKCOLT。LSP
 

查看完整版本: 寻找Lisp例程