LISP例程选择linewei
你好我是新来的论坛，我想一些帮助与Lisp程序例行程序。
我需要例行程序来执行以下操作：
1.选择图纸中的所有项目，并按5的比例放大。
2.选择线宽为“0.50mm”的所有项目，将颜色更改为“按层”，并将其放置在“0existing”层上。
3.选择“第1层”上的所有项目，并将其放置到“0”层。
希望有人能帮上忙，这听起来不算多，但会节省我很多时间！
谢谢 首先：
(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) 欢迎来到CADDutor andy_06。
你的个人资料上说你正在使用LT？
如果使用LT，lisp将无法工作。 非常感谢，这几乎是我正在寻找的，这是伟大的！
此时，它将我的地图缩放到正确的大小，并将0.50mm线宽放置到正确的图层上。
唯一似乎不起作用的部分是0.50mm线宽保持为红色，但如果可能的话，我需要将其更改为“按层”？
第三阶段，我需要“第1层”上的所有内容在最后转移到“0”层。
当我使用它的时候，我可能会想到更多的事情，但这是一个很好的开始，所以非常感谢。
嗨，Dadgad，
很抱歉，我已经更新了我的个人资料！
似乎我在“第1层”上打错了字——我写的是“第1层”，
此外，实体似乎不会通过从其elist中删除GC 62来更改其颜色ByLayer。。让我们试试subst GC 62到（62.256）：
(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)
谢谢你的代码Grrr！
代码中替换线型的部分似乎工作正常。
Tho。。。它检查块内容的部分并不是什么都没有。但doenst给出了错误消息。
它只是不改变块内的线型。
希望可以解决此问题。：-）
嗯，我似乎找不到问题，编辑代码以重新生成所有视口（红色文本）。如果仍然不起作用，我将尝试用visual lisp重新编写块迭代。 Your request starts to spin my head, however try this:
(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx ce )(setq lyr1 "Layer 1");
页:
[1]
2