请大师定制一切属性随层且线型为1，RMB50元感谢！（已解决）

lingduwx

请大师定制一切属性随层且线型为1，RMB 50元感谢！请大师们有意的私聊（主要是感谢费不多，只能给一个满足要求的人，望大家海涵），如果大家觉得价格问题可以私下协商，主要是论坛里面的不适合我，所以肯定大家帮帮忙，要求及cad测试文件如下，先谢谢了，

kucha007

lingduwx 发表于 2022-11-27 20:55
谢谢你的关注，这个可能不是我想要的,不好意思了

才看到你的要求还挺多，试着又改了一下(改图层0、颜色随层、线型随层、线型比例1、线宽随层)。另外我有一点好奇，线型随层又移动到0图层，相当于原有的线型丢失了啊。另外空选对象时你要不要复位样式？

469229020@QQ.CO

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)

469229020@QQ.CO

将所有图层随层
(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

楼下已更新

中国梦

谢谢分享支持

lingduwx

469229020@QQ.CO 发表于 2022-11-27 17:08
defun c:QW  ()
  (setvar "clayer" "0")
)

谢谢你的关注，这个可能不是我想要的,不好意思了

lingduwx

kucha007 发表于 2022-11-27 18:35
试试这个（目前只改了图层、颜色、线型比例）

非常感谢楼主，这个非常好，还有就是：1、如果本来就是随层的线，这个如果改为了其他颜色，使用命令后不能改为跟随所在图层颜色。2、可以取消使用命令后的选颜色这个功能。谢谢，

kucha007

lingduwx 发表于 2022-11-27 21:01
非常感谢楼主，这个非常好，还有就是：1、如果本来就是随层的线，这个如果改为了其他颜色，使用命令后不 ...

仔细看了需求又改了，你再试试

lingduwx

kucha007 发表于 2022-11-27 21:00
才看到你的要求还挺多，试着又改了一下(改图层0、颜色随层、线型随层、线型比例1、线宽随层)。另外我有一 ...

谢谢楼主，你的第一个更接近我的使用习惯