识别线型指定层

惜惜2

帮忙写一个LISP可以把块炸开然后放入0层，0层的颜色以及线型线宽随层，其中需要优先点选一个图元(同时全选相同线型的所有图元）指定到Bend层，如果BEND层不存在则自动创建，bend层颜色黄色，线型随层，线宽随层，点选的图元颜色随层，线宽随层，然后把剩余的图元放入0层。



(defun C:A11()
(vl-cmdf "qaflags" 1 "explode" (ssget "x") "" "qaflags" 0)
(if (= (getvar "cmdactive") 0)
(progn
(vl-cmdf "change" (ssget "x") "" "p" "la" 0 "")
(vl-cmdf "change" (ssget "x") "" "p" "c" "ByLayer" "")
(vl-cmdf "change" (ssget "x") "" "p" "LT" "ByLayer" "")
)
)
(command"_copyclip"(ssget "x" '((8 . "0"))))
(command"")
(princ)
)

qazxswk

别人帮你回答了问题，你却设置成仅作者可见？你也太自私了吧。这不利于论坛的发展，别人也无心来回答你的问题了。

惜惜2

qazxswk 发表于 2024-9-5 03:27
别人帮你回答了问题，你却设置成仅作者可见？你也太自私了吧。这不利于论坛的发展，别人也无心来回答你的问 ...

(defun c:A11 ()
    (vlax-for blockref (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
        (if (vlax-property-available-p blockref 'Explode)
            (vlax-invoke blockref 'Explode)
        )
    )
    (setq bend-layer-exists nil)
    (setq acad-doc (vla-get-activedocument (vlax-get-acad-object)))
    (setq layers (vla-get-layers acad-doc))
    (vlax-for layer layers
        (if (and layer (equal (strcase (vla-get-name layer)) "BEND"))
            (setq bend-layer-exists t)
        )
    )
    (if (not bend-layer-exists)
        (progn
            (setq newLayer (vla-add layers "BEND"))
            (vla-put-color newLayer 2) ;
            (setq linetypes (vla-get-linetypes acad-doc))
            (setq byLayerLinetype nil)
            (vlax-for linetype linetypes
                (if (equal (strcase (vla-get-name linetype)) "BYLAYER")
                    (setq byLayerLinetype linetype)
                )
            )
            (if byLayerLinetype
                (setq byLayerLinetypeName (vla-get-name byLayerLinetype))
            )
            (vla-put-lineweight newLayer -1) ; -1 表示 BYLAYER
        )
    )
    (setq picked-ent (car (entsel "\n 选择一个图元: ")))
    (if picked-ent
        (progn
            (setq ent-data (entget picked-ent))
            (if ent-data
                (progn
                    (setq linetype (cdr (assoc 6 ent-data)))
                    (setq filter (list (cons 0 (cdr (assoc 0 ent-data))) (cons 6 linetype)))
                    (setq same-linetype-ss (ssget "_X" filter))
                    (if same-linetype-ss
                        (progn
                            (setq i 0)
                            (repeat (sslength same-linetype-ss)
                                (setq entity (ssname same-linetype-ss i))
                                (if entity
                                    (progn
                                        (setq ent-obj (vlax-ename->vla-object entity))
                                        (vla-put-layer ent-obj "BEND")
                                    )
                                )
                                (setq i (1+ i))
                            )
                        )
                        (princ "\n 没有找到相同线型的图元.")
                    )
                    (setq remaining-ss (ssget "_X" (list (cons 0 (cdr (assoc 0 ent-data))))))
                    (if remaining-ss
                        (progn
                            (setq j 0)
                            (repeat (sslength remaining-ss)
                                (setq entity (ssname remaining-ss j))
                                (if entity
                                    (progn
                                        (setq ent-obj (vlax-ename->vla-object entity))
                                        (vla-put-layer ent-obj "0")
                                        (vla-put-linetype ent-obj byLayerLinetypeName)
                                        (vla-put-lineweight ent-obj -1)
                                    )
                                )
                                (setq j (1+ j))
                            )
                        )
                        (princ "\n 没有剩余图元.")
                    )
                )
                (princ "\n 无法获取实体数据.")
            )
        )
        (princ "\n 未选择图元.")
    )
    (princ)
)
大佬帮忙改下