求助一键切换回0图层，并使颜色、线型、线宽都随层
本帖最后由 highflybir 于 2022-11-30 10:41 编辑求助一键切换回0图层，并使颜色、线型、线宽都随层
(defun c:tt()(mapcar'setvar '("clayer" "cecolor""celtype""celweight")'("0""bylayer""bylayer"-1))) 这是我平时用的，你试下看看
(defun c:cc ()
(setvar "clayer" "0");设当前层为0层
(setvar "cecolor" "bylayer");设置颜色为随层
(setvar "celtype" "bylayer");设置线型为随层
(setvar "celweight" -1);设置线宽为随层
(princ)
) 本帖最后由 kucha007 于 2022-11-22 17:49 编辑
469229020@QQ.CO 发表于 2022-11-22 15:01
非常感谢各位大佬 ，真想给各位大佬每个人发一个红包，表示感谢。但不知道各位怎么联系。在此，谢谢各位了 ...
这是我自用的，用来复位参数。
01-若输入命令时选择了对象，就复位对象颜色线宽随层(线型不动)
01-若输入命令时未选择对象，就复位参数（0图层+当前随层+状态栏+字体样式+各种乱七八糟的东西)(defun c:FW (/ Old_Cmd)
(vl-load-com)
(setq Old_Cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(defun K:gxl-CatchApply (fun args / result)
(if (not
(vl-catch-all-error-p
(setq result (vl-catch-all-apply (if (= 'SYM (type fun)) fun (function fun))args))
)
)
result
)
)
(defun K:NewStyle (SNam Flag FNam BFNam Width / TS)
(vl-load-com)
(Setq TS (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))))
(if (= Flag T) ;T == TTF, nil == SHX
(progn ;TTF
(K:gxl-CatchApply 'vla-setfont (list (vla-add TS SNam) FNam "false" "false" 1 0))
(K:gxl-CatchApply 'vla-put-width (list (vla-add TS SNam) Width));设置宽度
)
(progn ;SHX
(K:gxl-CatchApply 'vla-put-fontfile (list (vla-add TS SNam) FNam))
(K:gxl-CatchApply 'vla-put-bigfontfile (list (vla-add TS SNam) BFNam))
(K:gxl-CatchApply 'vla-put-width (list (vla-add TS SNam) Width));设置宽度
)
)
(princ)
)
(if (= (last (ssgetfirst)) nil)
(progn
(command "Clayer" 0)
(setvar "PICKSTYLE" 1);恢复编组选择
;DSETTINGS_状态栏复位
(command "FILETAB");显示顶部的文件选项卡
(command "WIPEOUT" "F" "OFF");关闭显示区域覆盖的边框
(setvar "ConstraintInfer" 0);关闭推断约束
;--
(setvar "SnapMode" 0);关闭格栅捕捉
(setvar "GridMode" 0);关闭格栅显示
(setvar "OrthoMode" 0);关闭正交捕捉
(setvar "AutoSnap" 8);开启极轴追踪
(setvar "POLARANG" (/ pi 4));设置极轴追踪增量角为45°
(setvar "OSMode" 703);开启二维对象捕捉，并设置对象捕捉类型
(setvar "3DOSMode" 11);关闭三维对象捕捉
(setvar "AutoSnap" 63);开启对象捕捉追踪
(setvar "UCSDETECT" 0);禁止动态UCS
(setvar "DynMode" 1);开启动态输入
(setvar "LWDisplay" 0);不显示线宽
(setvar "LWDEFAULT" 9);设置默认线宽为0.09mm
(setvar "TRANSPARENCYDISPLAY" 1);开启透明度显示
(setvar "QPMODE" 0);关闭快捷特性
(setvar "SELECTIONCYCLING" 0);关闭选择循环
(setvar "ANNOMONITOR" 0);关闭注释监视器
(while (> (getvar "CMDACTIVE") 0) (command PAUSE));等待前面的命令完成
;重置随层特性:颜色、线性、线宽、使用UCS标高
(setvar "cmdecho" 0)
(command "Cecolor" "bylayer");颜色随层
(command "CELTYPE" "bylayer");线型随层
(command "CELWEIGHT" -1);线宽随层
(setvar "OSNAPZ" 1);使用当前UCS标高替换Z值
;Units_单位精度
(SetVar "LUNITS" 2);设置线性单位。1 科学 2 小数 3 工程 4 建筑 5 分数
(SetVar "LUPREC" 1);设置所有只读线性单位和可编辑线性单位（其精度小于或等于当前 luprec 的值）的小数位位数。
(SetVar "AUNITS" 0);设置角度单位:0.十进制度数 1.度/分/秒 2.百分度 3.弧度 4.勘测单位
(SetVar "AUPREC" 1);设置所有只读角度单位（显示在状态行上）和可编辑角度单位（其精度小于或等于当前 auprec 的值）的小数位数。
;LINETYPE_线型相关
(setvar "PSLTSCALE" 0);缩放时不使用视口比例
(setvar "LTSCALE" 10);设置全局缩放比例
(setvar "CELTSCALE" 1);设置当前对象比例为1
;字体样式
(K:NewStyle "_TCH_DIM" nil "hztxt_e" "hztxt" 0.8);SHX：使用大字体
(setvar "TextStyle" "_TCH_DIM");将_TCH_DIM设置为当前字体样式
)
(progn
(command "chprop" (ssget) ""
"color" "bylayer"
;"ltype" "bylayer"
"lweight" "bylayer" ""
);将所选对象移动到指定图层，并设置为随层
(while (> (getvar "CMDACTIVE") 0) (command PAUSE));等待前面的命令完成
)
)
(setvar "cmdecho" Old_Cmd)(princ)
)
(defun c:QW()
(change "clayer" "0" " "C" "ByLayer" "LT" "ByLayer""Lw" "ByLayer""")
(princ)
)
;这个语句是一键返回0图层。但是，同时把颜色，线型，线宽都切换成随层的，不知道哪里错了,老是报错。 应该错误出现在自定义函数change上 请教一下，切换返回图层函数是哪个 改为(vl-cmdf "_layer" "make" 吧。 本帖最后由 菜卷鱼 于 2022-11-22 11:21 编辑
我一直在用
(defun c:t0 ( / tn_ss )
(setq cmds (if command-s command-s vl-cmdf))
(setvar "cmdecho" 0 )
(setq ltsc (getvar "dimscale"))
(PRINC "0层")
(setq tn_ss (ssget ))
;(undobe)
(if (= tn_ss nil)
(progn (cmds "_.-layer" "m" "0" "")(princ "\n已设置为0层"))
(cmds "chprop" tn_ss """LA" "0" "S" LTSC "c" "bylayer""")
)
;(undoe)
(setvar "cmdecho" 1 )
(prin1)
)
非常感谢各位大佬 ，真想给各位大佬每个人发一个红包，表示感谢。但不知道各位怎么联系。在此，谢谢各位了，解决我初学小白的痛苦！感谢你们，感恩有你！ kucha007 发表于 2022-11-22 17:47
这是我自用的，用来复位参数。
01-若输入命令时选择了对象，就复位对象颜色线宽随层(线型不动)
01-若输 ...
很好很强大。
作品频传，点赞
页:
[1]
2