LISP例程选择linewei

andy_06 · 发表于 2022-7-5 16:55:39

你好

我是新来的论坛，我想一些帮助与Lisp程序例行程序。

我需要例行程序来执行以下操作：
1.选择图纸中的所有项目，并按5的比例放大。
2.选择线宽为“0.50mm”的所有项目，将颜色更改为“按层”，并将其放置在“0existing”层上。
3.选择“第1层”上的所有项目，并将其放置到“0”层。

希望有人能帮上忙，这听起来不算多，但会节省我很多时间！

谢谢

Grrr · 发表于 2022-7-5 16:59:29

首先：

copy

(defun C:test ( / SSX i e enx )
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
        (progn
                (command "_.SCALE" SSX "" '(0. 0. 0.) 5)
                (repeat (setq i (sslength SSX))
                        (setq e (ssname SSX (setq i (1- i))))
                        (setq enx (entget e))
                        (if (= "Layer1" (cdr (assoc 8 enx)))
                                (entupd (cdr (assoc -1 (entmod (setq enx (subst (cons 8 "0") (assoc 8 enx) enx))))))
                        )
                        (if (and (assoc 370 enx) (= 50 (cdr (assoc 370 enx))))
                                (progn
                                        (setq enx (vl-remove-if '(lambda (x) (member (car x) '(62 420))) enx))
                                        (setq enx (subst (cons 8 "0") (assoc 8 enx) enx))
                                        (entupd (cdr (assoc -1 (entmod enx))))
                                )
                        )                
                )
                (vla-ZoomExtents (vlax-get-acad-object))
        )
)
(princ)
);| defun |; (vl-load-com) (princ)

Dadgad · 发表于 2022-7-5 17:04:14

欢迎来到CADDutor andy_06。

你的个人资料上说你正在使用LT？
如果使用LT，lisp将无法工作。

andy_06 · 发表于 2022-7-5 17:05:39

非常感谢，这几乎是我正在寻找的，这是伟大的！

此时，它将我的地图缩放到正确的大小，并将0.50mm线宽放置到正确的图层上。
唯一似乎不起作用的部分是0.50mm线宽保持为红色，但如果可能的话，我需要将其更改为“按层”？
第三阶段，我需要“第1层”上的所有内容在最后转移到“0”层。

当我使用它的时候，我可能会想到更多的事情，但这是一个很好的开始，所以非常感谢。

andy_06 · 发表于 2022-7-5 17:09:19

嗨，Dadgad，

很抱歉，我已经更新了我的个人资料！

Grrr · 发表于 2022-7-5 17:13:30

似乎我在“第1层”上打错了字——我写的是“第1层”，
此外，实体似乎不会通过从其elist中删除GC 62来更改其颜色ByLayer。。让我们试试subst GC 62到（62.256）：

copy

(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx )
(setq lyr1 "Layer 1");<- type your layername here
(setq lyr0 "0existing");<- type your layername for lineweight 0.50mm
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(defun emakeLay (nm)
        (or (tblsearch "LAYER" nm)
                (progn
                        (alert (strcat "\nLayer "" nm "" does not exist, creating it!"))
                        (entmakex (list (cons 0 "LAYER")(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 nm)(cons 70 0)))
                )
        )
        (princ)
); defun emakeLay
(mapcar 'emakeLay (list lyr0 lyr1))
(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
        (progn
                (command "_.SCALE" SSX "" '(0. 0. 0.) 5)
                (repeat (setq i (sslength SSX))
                        (setq e (ssname SSX (setq i (1- i))))
                        (setq enx (entget e))
                        (if (= lyr1 (cdr (assoc 8 enx)))
                                (entupd (cdr (assoc -1 (entmod (setq enx (subst (cons 8 "0") (assoc 8 enx) enx))))))
                        )
                        (if (and (assoc 370 enx) (= 50 (cdr (assoc 370 enx))))
                                (progn
                                        (setq enx (vl-remove-if '(lambda (x) (= (car x) 420)) enx))
                                        (if (assoc 62 enx) (setq enx (subst (cons 62 256) (assoc 62 enx) enx)))
                                        (setq enx (subst (cons 8 lyr0) (assoc 8 enx) enx))
                                        (entupd (cdr (assoc -1 (entmod enx))))
                                )
                        )                
                )
                (vla-Regen acDoc acActiveViewport)
                (vla-ZoomExtents (vlax-get-acad-object))
        )
)
(princ)
);| defun |; (vl-load-com) (princ)