将实体更改为图层

rookie37 · 发表于 2022-7-6 14:29:19

阿德苏为我写了一个很棒的节目。这为我节省了大量的工作。

Adesu或其他人
你能帮我让它更人性化一点吗？

目前，它选择（并将继续选择）单个实体
可以修改它吗？如果它缺少一个实体，它将绘制一个框，我可以将其放置在几个对象周围？

此外，底部lccl的程序不工作。我不知道如何创建具有线型的图层
而不是连续的。中心已加载，但仍无法工作

;该程序在实体上选择单个
; 并将其更改为特定层。
;如果该层不存在，
;它也会创造它
;作者：DonaldChristensen，有很多帮助
;谢谢Adesu

;;;;;换层；；；；；；；

（定义c:ldef（/ss）
（虽然
（setq ss（car（entsel“\n选择要移动层的对象”））
（命令“_layer”“m”“defpoints”“c”8”）
（命令“_chprop”ss““la”“defpoints”）
) ; 虽然
（普林斯）
)

;;;混凝土示例lc18=（层，concrete_018）
（定义c:lc18（/ss）
（虽然
（setq ss（car（entsel“\n选择要移动层的对象”））
（命令“\u layer”“m”“concrete\u 018”“c”“magenta”“”“”）
（命令“_chprop”ss““la”“concrete\u 025”）
) ; 虽然
（普林斯）
)

（；层混凝土中心线
（定义c:lccl（/ss）
（虽然
（setq ss（car（entsel“\n选择要移动层的对象”））
（命令“\u layer”“m”“concrete\u cl”“c”“red”“l”“center”“”“”）
（命令“_chprop”ss““la”“concrete\u 025”）
) ; 虽然
（普林斯）
)

)

CarlB · 发表于 2022-7-6 14:43:20

这里是对一个例程的修改，以允许组选择。如果您喜欢，可以修改其他类似的内容。

copy

(defun c:ldef (/ ss)
  (princ "\nSelect object to move to DEFPOINTS layer")
  (setq ss (ssget))
  (command "_layer" "m" "defpoints" "c" 8 "" "")
  (command "_chprop" ss "" "la" "defpoints" "")
  (princ)
)

中心线未显示的问题可能是因为这两条线之间存在差异：

（命令“\u layer”“m”“concrete\u cl”“c”“red”“l”“center”“”“”）
（命令“_chprop”ss““la”“concrete\u 025”）

您需要在每个层中使用相同的层名称。

享受

kpblc · 发表于 2022-7-6 14:56:55

另一个Ж

copy

(defun c:chlay (/ adoc ent selset lay)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (if (and (setq ent (car (entsel "\nPick an object <Cancel> : ")))
          (setq selset (ssget "_:L"))
          ) ;_ end of and
   (progn
     (setq lay (vla-get-layer (vlax-ename->vla-object ent)))
     (foreach item
              (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                      ) ;_ end of mapcar
       (vl-catch-all-apply '(lambda () (vla-put-layer item lay)))
       ) ;_ end of foreach
     ) ;_ end of progn
   ) ;_ end of if
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
 ) ;_ end of defun

rookie37 · 发表于 2022-7-6 15:05:32

卡尔布
谢谢你的节目

lccl上的一个简单错误令人尴尬。然而，当我修复它时，它仍然不起作用

（定义c:lccl（/ss）
（princ“\n选择要移动到混凝土层的对象”）
（setq ss（ssget））
（命令“\u layer”“m”“concrete\u cl”“c”“red”“l”“center”“”“”）
（命令“_chprop”ss”““la”“concrete\u cl”“”）
（普林斯）
)

Cad64 · 发表于 2022-7-6 15:13:28

试试这个：

copy

 
(defun c:lccl (/ ss)
(princ "\nSelect object to move to concrete_cl layer")
(setq ss (ssget))
(command "_.layer" "Make" "concrete_cl" "C" "1" "" "L" "center" "" "")
(command "_.chprop" ss "" "la" "concrete_cl" "")
(princ)
)

rvzenteno · 发表于 2022-7-6 15:27:28

下面是我用来在特定层中绘制引线或DIM的例程。如果该层不存在，则创建该层。刚刚添加到Cad64的SSget例程末尾。

（定义c:cd（/ss）
（setq oldlay（getvar“clayer”）；保存其所在的当前图层
（if（null（tblsearch“layer”“NEWLAYER”）；对特定图层的图层表进行条件if搜索
（命令“.layer”“make”“NEWLAYER”“c”“30”“l”“Continuous”“”“”）；如果不可用，则使用特定配置创建它
（setvar“clayer”“NEWLAYER”）；创建新层后，将其设置为当前层
)
（princ“\n选择要移动到新图层的对象：”）
（setq ss（ssget））
（命令“_.chprop”ss““la”“NEWLAYER”）
（setvar“clayer”oldlay）
（普林斯）

David Bethel · 发表于 2022-7-6 15:38:33

还有另一种类型：

大卫

[编程交流] 将实体更改为图层

发表回复

精选推荐