请大师定制一切属性随层且线型为1，RMB50元感谢！（已解决）
本帖最后由 lingduwx 于 2022-11-28 16:01 编辑请大师定制一切属性随层且线型为1，RMB 50元感谢！请大师们有意的私聊（主要是感谢费不多，只能给一个满足要求的人，望大家海涵），如果大家觉得价格问题可以私下协商，主要是论坛里面的不适合我，所以肯定大家帮帮忙，要求及cad测试文件如下，先谢谢了，
本帖最后由 kucha007 于 2022-11-29 10:39 编辑
lingduwx 发表于 2022-11-27 20:55
谢谢你的关注，这个可能不是我想要的,不好意思了
才看到你的要求还挺多，试着又改了一下(改图层0、颜色随层、线型随层、线型比例1、线宽随层)。另外我有一点好奇，线型随层又移动到0图层，相当于原有的线型丢失了啊。另外空选对象时你要不要复位样式？
defun c:QW()
(setvar "clayer" "0")
)
;这个语句是一键返回0图层。
(if (not (tblsearch "Ltype" "center"))
(command "linetype" "l" "center" "acadiso.lin" "")
)
;检测图形中是否有线型center，如果没有则加载调入，有则忽略。
(if (not (tblsearch "Ltype" "PHANTOM"))
(command "linetype" "l" "PHANTOM" "acadiso.lin" "")
)
;检测图形中是否有线型PHANTOM，如果没有则加载调入，有则忽略。
(if (null (tblsearch "layer" "折弯线"))
(entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord") '(6 . "PHANTOM") '(62 . 6) '(370 . 0) '(70 . 0) '(290 . 1) '(2 . "折弯线")))
;6组码【线型】,62组码【颜色】,370组码【线宽】,70组码【可见】,290组码【打印】，2组码【图层名称】
);autolisp建立图层
(if (null (tblsearch "layer" "1激光打标层"))
(entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord") '(6 . "CENTER") '(62 . 2) '(370 . 0) '(70 . 0) '(290 . 1) '(2 . "1激光打标层")))
;6组码【线型】,62组码【颜色】,370组码【线宽】,70组码【可见】,290组码【打印】，2组码【图层名称】
);autolisp建立图层
(if (null (tblsearch "layer" "0"))
(entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord") '(6 . "Continuous") '(62 . 7) '(370 . 0) '(70 . 0) '(290 . 1) '(2 . "0")))
;6组码【线型】,62组码【颜色】,370组码【线宽】,70组码【可见】,290组码【打印】，2组码【图层名称】
);autolisp建立图层
(defun c:G()
(setvar "cmdecho" 0)
(command "_.chprop" (ssget) "" "C" "ByLayer" "LA" "折弯线" "LT" "ByLayer" "")
(princ)
)
(defun c:R()
(setvar "cmdecho" 0)
(command "_.chprop" (ssget) "" "C" "ByLayer" "LA" "1激光打标层" "LT" "ByLayer" "")
(princ)
)
(defun c:Q()
(setvar "cmdecho" 0)
(command "_.chprop" (ssget) "" "C" "ByLayer" "LA" "0" "LT" "ByLayer" "")
)
(princ"\n***原理是程序会自动首先检测图层***\n***折弯线和1激光打标层***\n***是否存在如果没有则新建生成没有的图层***\n***如果已有图层则忽略不新建***\n***注意*图形需炸开是散线*自己定义的使用命令不要与其它命令冲突**\n***使用命令Q键将所选图形归0层**\n***命令R键将所选图形归1激光打标层**\n***命令G键将所选图形归折弯线图层**\n***本程序由余木华制作***欢迎您的指导和斧正*请多指教！**")
(prin1) 将所有图层随层
(defun C:ccc (/ )
(vl-load-com)
(setq ModelSpace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for obj ModelSpace
(if (/= (vla-get-color obj) 256)
(vla-put-color obj 256)
)
)
)
修改图层颜色
(defun c:tc()
(vl-load-com)
(setq acmCol (vla-getinterfaceobject
(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))
(vlax-for x (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(cond
((= (vla-get-name x) "注记") (vla-setrgb acmCol 255 255 255) (vla-put-TrueColor x acmCol))
)
)
) 本帖最后由 kucha007 于 2022-11-27 21:28 编辑
楼下已更新
谢谢分享支持 469229020@QQ.CO 发表于 2022-11-27 17:08
defun c:QW()
(setvar "clayer" "0")
)
谢谢你的关注，这个可能不是我想要的,不好意思了 kucha007 发表于 2022-11-27 18:35
试试这个（目前只改了图层、颜色、线型比例）
非常感谢楼主，这个非常好，还有就是：1、如果本来就是随层的线，这个如果改为了其他颜色，使用命令后不能改为跟随所在图层颜色。2、可以取消使用命令后的选颜色这个功能。谢谢， lingduwx 发表于 2022-11-27 21:01
非常感谢楼主，这个非常好，还有就是：1、如果本来就是随层的线，这个如果改为了其他颜色，使用命令后不 ...
仔细看了需求又改了，你再试试 kucha007 发表于 2022-11-27 21:00
才看到你的要求还挺多，试着又改了一下(改图层0、颜色随层、线型随层、线型比例1、线宽随层)。另外我有一 ...
谢谢楼主，你的第一个更接近我的使用习惯