简化lisp，选择对象，乐筑天下 - Powered by Discuz! Archiver

Aftertouch 发表于 2022-7-5 16:02:09

简化lisp，选择对象，

大家好，
我设法构建了一个lisp，它允许我选择外部参照的直线、多段线、圆弧或圆，并将该外部参照的图层的图层颜色更改为选定的颜色，可以是indexcolor、truecolor或colorbook颜色。。。

然而我认为这段代码可以简单得多。。。
有什么建议吗？

(defun C:ChangeLayerColor ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor)
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(setq selectedobject (nentsel "\nSelect a line, polyline, circle or arc to change its layers color: "))
(if (/= selectedobject nil)
(progn
(if (/= (cdr (assoc 410 (entget (car selectedobject)))) nil)
(progn
(setq selectedobject (entget (car selectedobject)))
(setq selectedobjecttype (cdr (assoc 0 selectedobject)))
)
(progn
(setq selectedobject (entget (car (nth 3 selectedobject))))
(setq selectedobjecttype (cdr (assoc 0 selectedobject)))
)
)
(cond
((= selectedobjecttype (car (member selectedobjecttype (list "LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))))
(setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
)
(t
(setq selectedobjectlayer nil)
)
)
(if (/= selectedobjectlayer nil)
(progn
(setq layercolor (acad_truecolordlg 253 nil))
(if (/= layercolor nil)
(progn
(if (/= (car (cddr layercolor)) nil)
(progn
(setq layercolor (cdr (car (cddr layercolor))))
(setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
(setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
(command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
(princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
)
(progn
(if (/= (car (cdr layercolor)) nil)
(progn
(setq layercolor (OLEtoRGB_color (cdr (car (cdr layercolor)))))
(setq layercolor (strcat (itoa (car layercolor))","(itoa (car (cdr layercolor)))","(itoa (car (cddr layercolor)))))
(command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
(princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
)
(progn
(setq layercolor (cdr (car layercolor)))
(command-s "-Layer" "Color" layercolor selectedobjectlayer "")
(princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
)
)
)
)
)
(progn
(princ "\nCancelled...")
)
)
)
(progn
(princ "\nInvalid selection.")
)
)
)
(progn
(princ "\nCancelled...")
)
)
(command "UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)

(defun OLEtoRGB_color (OLE_color / r g b)
(setq r (lsh OLE_color -16))
(setq g (lsh (lsh OLE_color 16) -24))
(setq b (lsh (lsh OLE_color 24) -24))
(list r g b)
)

(princ)

Jef! 发表于 2022-7-5 16:26:02

Hi Aftertouch。这里有一些想法。

（if（/=selectedobject nil）可以替换为（if selectedobject）。更简洁易读。很少有地方使用相同的逻辑。
（if（/=（cdr（assoc 410（entget（car selectedobject）））nil）可以替换为（if（assoc 410（entget（car selectedobject）））。如果assoc 410 deosn不存在，它将返回nil并计算If的“else”部分。也就是说，如果不进行深入分析，我不确定为什么要检查410组代码是否存在，如果存在，则使用第n个3，但我注意到，由于selectedobjecttype在这两种情况下设置为相同，因此可以从if中删除该部分，而不是在if的两个条件和下复制。这样也可以移除2个尖头。

同样，对于cond，您只需要查看selectedobjecttype是否是列表的成员。如果是，则selectedobjecttype将始终等于成员返回的列表的car。还要注意的是，conditional的（t部分是无用的。如果它是列表的成员，则将设置selectedobjectlayer（cdr（assoc 8 selectedobject）），但如果它不是成员，则selectedobjectlayer不存在，因此无需将其设置为nil，因为它已经是nil。如果删除cond的（t）部分，则会得到一个具有单个条件的cond，因此可以将其替换为If语句。哦，由于列表不会变化，因此可以引用它，而不是使用（list）来构建它

（if（/=selectedobjectlayer nil）替换为（if selectedobjectlayer
（if（/=layercolor nil）替换为（if layercolor
基本上在剩下的部分中，我使用了cond而不是嵌套if，因为对于3个选项（配色系统/真彩色/索引），它更具可读性。我还将（cdr（car（cdr layercolor）））更改为（cdadr layercolor）。括号更少，可读性更强。我没有修改任何其他内容，因为它的执行似乎完美无瑕。

(defun C:CLC ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor OLDCMDECHO)
(setq OLDCMDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(setq selectedobject (nentsel "\nSelect a line, polyline, circle or arc to change its layers color: "))
(if selectedobject
(progn
(if (assoc 410 (entget (car selectedobject)))
   (setq selectedobject (entget (car selectedobject)))
   (setq selectedobject (entget (car (nth 3 selectedobject))))
)
                  (setq selectedobjecttype (cdr (assoc 0 selectedobject)))
(if (member selectedobjecttype '("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))
                        (setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
)
(if selectedobjectlayer
(progn
(setq layercolor (acad_truecolordlg 253 nil))
(if layercolor
                                          (cond ((cddr layercolor)
                                                   (setq layercolor (cdaddr layercolor))
                                                   (setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
                                                   (setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
                                                   (command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
                                                   (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
                                                )
                                                ((cdr layercolor)
                                                   (setq layercolor (OLEtoRGB_color (cdadr layercolor)))
                                                   (setq layercolor (strcat (itoa (car layercolor))","(itoa (cadr layercolor))","(itoa (caddr layercolor))))
                                                   (command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
                                                   (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
                                                )
                                                ((setq layercolor (cdr (car layercolor)))
                                                   (command-s "-Layer" "Color" layercolor selectedobjectlayer "")
                                                   (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
                                                )
                                          )
(princ "\nCancelled...")
)
)
(princ "\nInvalid selection.")
)
)
(princ "\nCancelled...")
)
(command "UNDO" "END")
(setvar "cmdecho" OLDCMDECHO)
(princ)
)

旁注：最好避免多次使用（entget）。您可以使用selectedobject，但由于我不明白您在检查410的存在性时的目标是什么，因此我无法提供多次调用entget的替代方法。
不要随意更改变量（如cmdecho）。将变量OLDCMDECHO设置为原始值，并根据需要进行更改。最后，使用OLDCMDECHO将变量恢复为其原始值。

干杯

Aftertouch 发表于 2022-7-5 16:30:31

嘿，杰夫，谢谢你的反馈。
关于assoc 410部分：

(if (assoc 410 (entget (car selectedobject)))
(setq selectedobject (entget (car selectedobject)))
(setq selectedobject (entget (car (nth 3 selectedobject))))
)

我在这里试图做的是，当选定的对象没有410属性（模型）时，那么它是块的一部分。
在这种情况下，使用选定对象的（第n个3），它是选定线的父块（它位于第0层的块中）。

ronjonp 发表于 2022-7-5 16:41:21

您还可以检查nentsel列表的长度。。如果是嵌套的，则长度将大于2。
(setq e (nentsel))
(cond ((caddr e) (car (last e)))
((car e))
)

这里还有另一种构建代码的方法：
(if (and (setq selectedobject
(nentsel "\nSelect a line, polyline, circle or arc to change its layer color: "
)
)
(setq selectedobject
(cond ((caddr selectedobject) (car (last selectedobject)))
((car selectedobject))
)
)
;; Why check object type?
(vl-position
(cdr (assoc 0 (entget selectedobject)))
'("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC")
)
(setq layercolor (acad_truecolordlg 253 nil))
)
(cond ((assoc 430 layercolor) "do your colorbook stuff")
((assoc 420 layercolor) "do your truecolor stuff")
("do your aci stuff")
)
)

Jef! 发表于 2022-7-5 16:50:32

啊。。。我懂了。2件事。进一步检查项目的性质是否是该列表的成员：（“LINE”“LWPOLYLINE”“CIRCLE”“DIMENSION”“TEXT”“INSERT”“ARC”），因此如果是块插入，则需要检查两次。我将通过使用entsel而不是entsel来摆脱第一个额外步骤。在这里使用entsel对所有实体都是相同的操作。（仅当需要nentsel时才使用nentsel）。

通过在if中移动setq，可以进一步减少代码的长度。

(defun C:CLC ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor OLDCMDECHO)
(setq OLDCMDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(if (setq selectedobject (entsel "\nSelect a line, polyline, circle or arc to change its layers color: "))
(progn
                  (setq selectedobjecttype (cdr (assoc 0 (setq selectedobject (entget (car selectedobject))))))
(if (member selectedobjecttype '("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))
                        (setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
)
(if selectedobjectlayer
(progn
(if (setq layercolor (acad_truecolordlg 253 nil))
                                          (cond ((cddr layercolor)
                                                   (setq layercolor (cdaddr layercolor))
                                                   (setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
                                                   (setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
                                                   (command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
                                                   (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
                                                )
                                                ((cdr layercolor)
                                                   (setq layercolor (OLEtoRGB_color (cdadr layercolor)))
                                                   (setq layercolor (strcat (itoa (car layercolor))","(itoa (cadr layercolor))","(itoa (caddr layercolor))))
                                                   (command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
                                                   (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
                                                )
                                                ((setq layercolor (cdr (car layercolor)))
                                                   (command-s "-Layer" "Color" layercolor selectedobjectlayer "")
                                                   (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
                                                )
                                          )
(princ "\nCancelled...")
)
)
(princ "\nInvalid selection.")
)
)
(princ "\nCancelled...")
)
(command "UNDO" "END")
(setvar "cmdecho" OLDCMDECHO)
(princ)
)

如果这是我的项目，我可能会做其他事情：制作OLEtoRGB_颜色的变体，直接返回您需要的颜色，即“99171207”，而不是需要进一步处理的（99171 207）。可能是一个接受任何颜色格式和图层作为参数的sub，以使颜色相应地改变。当诸如acad_truecolordlg（点对中的str或int（（62.43）（420.13676676）（430。“RAL CLASSIC$RAL 1001”））之类的函数可以返回不同格式时，使用vl princ to string可以删除一堆代码。验证更少，处理方式独特。（vl princ将wathever串起来，而不必根据性质以不同的方式对其进行操作。（itoa/rtos/as is if str）

最后一点，当你有很多if时，遵循流程可能是一个挑战，代码可以跨越许多行。它们可以嵌套，也可以一个接一个地嵌套。
如果（…）比做一个
如果A大于B
如果B大于C
Nested if:
(if (...)
(if A
(if B
C)
)
)
Chain of if:
(if (...)
A
)
(if A
B
)
(if B
C
)

And alternative:
(and (...)
   A
   B
   C
)
And和Or函数可以极大地帮助使代码更加简洁易读。看看Ron的例子
@Ronjonp你有一个（列表缺失！

ronjonp 发表于 2022-7-5 17:07:18

好眼力。。固定的

页: [1]

乐筑天下's Archiver

简化lisp，选择对象，