社区 › Auto Lisp › 帮助循环#039；转换Byl

Micko79 发表于 2022-7-6 08:42:57

帮助循环#039；转换Byl

大家好，我是Lisp新手，在循环下面的Lisp时遇到了麻烦。我试图选择对象，然后将它们放在与其颜色和线型相关的图层上。例如，我想选择一个BYLAYER=红色和虚线的对象，然后将其放置在名为1DASHED的层上。我已经用下面的代码运行了它，但因为我使用了NENTSEL，我一次只能选择一个对象（它可以工作），我需要它循环运行整个图形中的每个对象，但每次我尝试循环时，我都会收到一个错误，说VARITYP或类似的东西（现在在家里，没有CAD来重新生成错误），我查找了它，这意味着我引用的是一个选择集，而不是一个列表。请帮忙循环这个。我绝望了。
 
（定义C:QQQ（/esl laycol）
 
（while（not（setq esl（nentsel）））；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；
 
（setq LayCol（cdr（cadddr（tblsearch“layer”（cdr（assoc 8（entget（car esl k k）а）））））
（setq LayLin（Cdr（cdddr（tblsearch“layer”（Cdr（assoc 8（entget（car esl Ϟ）Ϟ））））））
（setq LayName（strcat（rtos LayCol）LayLin））
 
（命令“LAYER”“m”LayName“C”laycol LayName“Ltype”LayLin LayName“”）
（命令“CHPROP”esl““LA”LayName“C”“BYLAYER”“LType”“BYLAYER”）
 
)

pBe 发表于 2022-7-6 08:52:37

欢迎来到Micko79论坛
 
试试这个
 

(defun c:LayMod (/ aDoc lyrsColl ltpotd Lyrs ss ent nme)
(vl-load-com)
(setq aDoc(vla-get-ActiveDocument (vlax-get-acad-object))
lyrsColl (vla-get-layers aDoc)
ltpotd(vla-get-linetypes aDoc)
)
(defun _dxf (ent dx_) (cdr (assoc dx_ ent)))
(defun _lyslst (/ Laylst)
   (while (setq a (tblnext "Layer" (null a)))
   (if (not (wcmatch (_dxf a 2) "*|*"))
(progn (setq lyp (tblsearch "Layer" (_dxf a 2)))
       (setq
Laylst (append
    (list (_dxf a 2) (itoa (_dxf a 62)) (_dxf a 6))
    Laylst
)
       )
)
   )
   )
   Laylst
)
(setq Lyrs (_lyslst))
(if (ssget ":L" '((0 . "~VIEWPORT")))
   (progn
   (vlax-for itm (setq ss (vla-get-ActiveSelectionSet aDoc))
(setq nme (member (vla-get-layer itm) Lyrs))
    (vla-put-layer
      itm
      (if (vl-catch-all-error-p
   (vl-catch-all-apply
       'vla-item
       (list lyrsColl
      (setq lynm (strcat (cadr nme) (caddr nme)))
       )
   )
   )
(progn (vla-add lyrsColl lynm)
      (vla-put-color
   (vla-item lyrsColl lynm)
   (atoi (cadr nme))
      )
      (if (= nil (tblsearch "LTYPE" (caddr nme)))
   (vla-add (vla-get-linetypes ltpotd (caddr nme)))
      )
      (vla-put-linetype
   (vla-item lyrsColl lynm)
   (caddr nme)
      )
      lynm
)
lynm
      )
    )
    (vla-put-linetype itm "ByLayer")
    (vla-put-color itm acByLayer)
)
   (vla-delete ss)
   )
)
(princ)
)

 
希望这有帮助
 
如果需要此选项来选择所有对象
更改此
（ssget“：L”'（（0.~视口”））
到
（ssget“_X”'（（0。“~视口”））

Tharwat 发表于 2022-7-6 09:04:04

希望你不要介意，如果我张贴我的尝试与香草代码。
 

(defun c:TesT (/ ss sset e l New)
;; Tharwat 07 Nov. 2011 ;;
(if (setq ss (ssget "_:L"))
   (repeat (setq i (sslength ss))
   (setq sset (ssname ss (setq i (1- i))))
   (setq e (entget sset))
   (setq l (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))
   (if (not
         (tblsearch
             "LAYER"
             (setq
               New (strcat (itoa (cdr (assoc 62 l))) (cdr (assoc 6 l)))
             )
         )
         )
       (progn
         (entmakex (list '(0 . "LAYER")
                         '(100 . "AcDbSymbolTableRecord")
                         '(100 . "AcDbLayerTableRecord")
                         (cons 2 New)
                         (assoc 62 l)
                         (assoc 6 l)
                         (cons 70 0)
                   )
         )
         (entmod (subst (cons 8 New) (assoc 8 e) e))
       )
       (entmod (subst (cons 8 New) (assoc 8 e) e))
   )
   )
   (princ)
)
(princ)
)

pBe 发表于 2022-7-6 09:08:16

不用担心，塔尔瓦特。我最初也是用vanilla编写的，但现在我总是假设OP使用注释性实体。
 
（entmod（subst（cons 8 New）（assoc 8 e）e））；
 
特别是对于注释性多行文字，上面的行会弄乱文字高度
 
干杯
 
顺便提一下
此外，您可能需要添加到例程中，根据OP的要求将颜色和线型更改为“Bylayer”

Tharwat 发表于 2022-7-6 09:14:08

使用entmod函数更改图层不会对注释性文本产生负面影响，这与更改文本高度的entmod相同。
 
这套程序按预期完成了任务，我想你没有试过，试试吧。

pBe 发表于 2022-7-6 09:25:53

塔瓦，我确实试过了，你认为我为什么建议这么做？
 
尝试将两个实体的颜色更改为1，将线型更改为虚线，然后运行例程
 
对于注释性多行文字，不要假设每个人在绘制时使用相同的单位

Tharwat 发表于 2022-7-6 09:32:00

 
因为大多数专家阅读代码都没有尝试过（毫无疑问，你就是其中之一）
 
 
 
这是完全正确的，我没有这样想。你说得对。
 
 
顺致敬意，

pBe 发表于 2022-7-6 09:37:54

 
我不是专家，真的。我确实先看了你的代码，我看到你使用了entmod，这促使我说我做了什么，所有这些都是因为我一直在使用这种方法，但对于注释性实体，你永远也不能太确定。
 
 
是的，这就是OP想要他的代码做的。
（命令“CHPROP”esl““LA”LayName“C”“BYLAYER”“LType”“BYLAYER”“）；
 
为我的朋友干杯。
 
 
 
 

SLW210 发表于 2022-7-6 09:42:57

请阅读代码发布指南并编辑您的帖子。

查看完整版本: 帮助循环#039；转换Byl