:2022-10-11，福利帖，CAD中将自己常用的命令整合成自用面板方便调用-PPT资讯免费ppt模版下载-道格办公

2022-10-11，福利帖，CAD中将自己常用的命令整合成自用面板方便调用---

1）将下面的文字复制，用“记事本”打开后粘贴，另存为*.lsp格式，然后在CAD中用appload加载（永久加载可以在“启动组”里加载），重启CAD后输入命令00即可调出本面板；

2）命令00可自己修改，里面的工具条也可以根据自己的喜好和常用频率DIY，注意，对应的工具条命令必须有支持源码lsp或者vlx或者fas支撑。

(defun c:00()

(if (null bbdigopen) (setq bbdigopen -29999))

(if (= bbdigopen -29999) (bbdig0) (bbdig1))

(princ))

(defun bbdig0 ()

(setq bbdigopen -29999)

(setq lst '(('文字工具'(

'tma 01文字同刷<tma> '

'wzjk 02文字加框<wzjk> '

'thlz 03同行连字<thlz> '

'tyzg 04统一字高<tyzg> '

'wzdq 05等行对齐<wzdq> '

'mat 06暴强刷子<mat> '

'ztkd 07字体宽度<ztkd> '

'et 08修改文字<et> '

'99 09表格居中<99> '

'ch3 10加前后缀<ch3> '

))

('图层工具'(

'zdjc 01自动建层<zdjc> '

'dq 02当前图层<dq> '

'ol 03框选关层<ol> '

'lf 04非选关层<lf> '

'qk 05图层全开<qk> '

'lk 06框选锁层<lk > '

'ylk 07框选解锁<ylk> '

'fsd 08非选锁层<fsd> '

'qjs 09全部解锁<qjs> '

' 大美留白 '

))

('标注工具'(

'lw 01水平标注<lw> '

'de 02竖向标注<de> '

'db 03断开标注<db> '

'bzhhb 04合并标注<bzhhb> '

'wzbr 05标注避让<wzbr> '

'cyshx 06裁剪标头<cyshx> '

'bzdq 07标注对齐<bzdq> '

'jzqh 08加注前后<jzqh> '

'hcbz 09弧长标注<hcbz> '

' 大美留白 '

))

('编辑工具'(

'bg 01标高大师<bg> '

'jbg 02复加标高<jbg> '

'sf 03原地缩放<sf> '

'roo 04原地旋转<roo> '

'xtsf 05详图缩放<xtsf> '

'num 06增减标高<num> '

'jyfz 07记忆复制<jyfz> '

'jyls 08记忆拉伸<jyls> '

'jyyd 09记忆移动<jyyd> '

' 大美留白 '

))

('绘图工具'(

'WRF_LMC 01绘立面窗<wrf_lmc> '

'WRF_LMM 02绘立面门<wrf_lmm> '

'zcmj 03周长面积<zcmj> '

'nM 04矩形编号<nm> '

'PEACE-TextSum 05数字求和<peace-textsum> '

'dxjy 06多选加一<dxjy> '

'dnd 07原位增值一<dnd> '

'kx 08连线偏移一<kx> '

' 大美留白 '

))

)

(Dcl-ButtonM (menucmd

'M=$(edtime,$(getvar,date), 阳羡刚刚好工具箱---现在时间是:YYYY/MO/DD DDD HH:MM:SS am/pm)'

) lst nil nil) ;lst nil nil为纵向布置，lst t nil为横向布置

(princ)

)

(defun bbdig1 ()

(setq bbdigopen -30000)

(setq lst '(('批量打印'(

'STPRINT 全能批量打印 '

'YCT_ZNST 易出图智能识图 '

'YCT_PLDY 易出图批量打印 '

'YCT_XZDY 易出图选择批打 '

))

('图签（块）编辑'(

'tcbh 页码编号 '

'MdfBlkTxt 属性块内文字编辑 '

'bedit 属性块内编辑 '

'TCBH 图签编号 '

'BATTMAN CAD属性块编辑器 '

'ATFL 图签属性批量编辑 '

'TCATTLIST 田草图签属性批量编辑 '

))

('辅助绘图'(

'lkx 绘制外轮廓线 '

'BianPoXian 绘制边坡线 '

'ljnn 边坡示坡线 '

'EBG_SPline2Pline 样条曲线转多段线 '

'PL_VTX_ADDEL 多段线添加或删除顶点 '

'apvPL 多段线添加顶点 '

))

('布局空间'(

'MSPACE 进入模型空间 '

'MVIEW 布局空间视口 '

'lzxj 空白1 '

'~xyp-jzl 空白2 '

'~zlh0c1 空白3 '

))

('其他工具'(

'acad2kml CAD转KML '

'zoom CAD缩放 '

'EBG_LockDwg 图纸加密 '

'EBG_Fonts_Distill 导出字体 '

'insg 载入91影像地图 '

'QingChu 清理垃圾 '

'tete 图纸裁剪lsp '

'PARTTRIM 图纸裁剪 '

'PARTTRIMSAVE 裁剪存图 '

'PEACE-BProp 块属性批量编辑 '

))

)

(Dcl-ButtonM (menucmd

'M=$(edtime,$(getvar,date), 阳羡刚刚好工具箱---现在时间是:YYYY/MO/DD DDD HH:MM:SS am/pm)'

) lst nil nil) ;lst nil nil为纵向布置，lst t nil为横向布置

(princ)

)

;;(boundp 'c:zlhc)

(vl-load-com)

;;反应器回调函数

(defun sk-cmdunknown(param1 param2)

(alert '!!!!未知命令或命令或开发中!!!!')

(vlr-remove sk-rctCmds)

)

;; titl:标题; buttons:按钮列表; flag:nil先行后列T先列后行 helpstr: nil '帮助字符串'

(defun Dcl-ButtonM (titl buttons flag helpstr / a b c)

(or (and helpstr (/= helpstr '')) (setq helpstr '!!!可根据修改工具栏为横向布置（lst nil nil为纵向布置，lst t nil为横向布置），命令前加~后按钮变成灰色不能使用（如：~aaa 工具名称）!!!'))

(defun strsplist (str / i)

(if (setq i (vl-string-search ' ' str))

(list (substr str 1 i)

(vl-string-trim ' ' (substr str (+ 2 i)))

)

(defun makedcl (str_lst / fileID dclHandle)

(setq dclfile (vl-filename-mktemp nil nil '.dcl')

fileID (open dclfile 'w')

)

(cond ((= (type str_lst) 'str) (write-line str_lst fileID))

((= (type str_lst) 'list)

(foreach n str_lst (write-line n fileID))

)

(close fileID)

(setq dclHandle (load_dialog dclfile))

)

(setq b (if flag

':column{ label = ''

':row{children_alignment = top ;

children_fixed_height = true ; label = ''

)

c (if flag

':row{children_alignment = top ;

children_fixed_height = true ; label = ''

':column{label = ''

)

d '('ESC')

a (strcat (vl-string-translate

'$~'

'AB'

(vl-filename-base (vl-filename-mktemp))

)

':dialog{label=''

titl

''; '

)

(foreach x buttons

(if (listp x)

(progn

(setq a (strcat a c (car x) ''; '))

(foreach y (last x)

(setq b (strsplist y)

a (if b

(strcat a

':button {key =''

(car b)

'';label=''

(last b)

'';'

(if (= (substr (car b) 1 1) '~')

'is_enabled = false ;' ' ')

'} '

)

(strcat a 'spacer_0; ')

)

d (if (/= (car b) nil)

(cons (car b) d)

)

(setq a (strcat a '} '))

)

(setq a (strcat a 'spacer_0; '))

)

(setq d (cdr (REVERSE d))

a (strcat a

(if flag

'} spacer_1;:row'

)

'{alignment = centered ;fixed_width = true ;

spacer_0;:button{fixed_width = true ;width = 12 ;key = 'zlhccygjt';label = ' 常用工具 ';} '

':button{fixed_width = true ;width = 12 ;key='zlhcqbgjt';label=' 全部工具 ';}'

':button{fixed_width = true ;width = 12 ;key = 'help';label = ' 关于 ';}'

':button{fixed_width = true ;width = 12 ;key='cancel';label=' 取消 ';

is_cancel = true;is_default = true;}}}'

;;; '{alignment = centered ; fixed_width = true ; spacer_0; cancel_button;

;;; :text{fixed_width = true ; width = 2; } help_button;}}'

;;; '{alignment = centered ; fixed_width = true ; help_button; :text{fixed_width = true ; width = 2; } cancel_button;}}'

)

dcl (makedcl a)

lst1 '()

i 1

)

(foreach key d

(setq tx (strcat '(action_tile ''

key

'''(done_dialog '

(itoa i)

')')'

)

lst1 (cons tx lst1)

i (1+ i)

)

(new_dialog (substr a 1 8) dcl)

(action_tile 'cancel' '(done_dialog 0)')

(action_tile 'help' '(alert helpstr)')

(action_tile 'zlhccygjt' '(done_dialog -29999)')

(action_tile 'zlhcqbgjt' '(done_dialog -30000)')

(eval (read (strcat '(progn' (apply 'strcat lst1) ')')))

(setq ctl (start_dialog))

(if (= ctl -29999) (bbdig0))(if (= ctl -30000) (bbdig1))

(UNLOAD_DIALOG dcl)

(vl-file-delete dclfile)

(if (/= ctl 0)

(progn

(setq cmds(nth (- ctl 1) d))

;;检查命令是否~开头,有就去掉,如果运行中没有更改该命令button的enable值,这句可以不要

(if (= (substr cmds 1 1) '~') (setq cmds (substr cmds 2 (1- (strlen cmds)))))

;;

;;; (cond

;;; ((or(= (eval (read (strcat '(type c:' cmds ')'))) 'SUBR)

;;; (= (eval (read (strcat '(type c:' cmds ')'))) 'USUBR))

;;; (princ ' ')

;;; (eval (read (strcat '(c:' cmds ')'))))

;;; ((or(= (eval (read (strcat '(type ' cmds ')'))) 'SUBR)

;;; (= (eval (read (strcat '(type ' cmds ')'))) 'USUBR))

;;; (princ ' ')

;;; (eval (read (strcat '(' cmds ')'))))

;;; (t (princ ' ')(vl-load-com)(vl-cmdf cmds))

;;; )

;设置未知命令反应器

(if (= sk-rctCmds nil)

(setq sk-rctCmds (vlr-command-reactor nil '((:vlr-unknownCommand . sk-cmdunknown))))

(vlr-add sk-rctCmds)

)

;新的命令判断方式,代码更短

(cond

((boundp (read (strcat 'c:' cmds)))

(princ ' ')

(eval (read (strcat '(c:' cmds ')'))))

((boundp (read cmds))

(princ ' ')

(eval (read (strcat '(' cmds ')'))))

(t (princ ' ')(vl-load-com)(vl-cmdf cmds))

)

文字加框

;;;*****文字加框程序开始*****

(defun c:WZjk()

(setvar 'cecolor' '6');设置新对象的颜色

(if (= OF nil)(setq OF 0.5))

(setq OF (KX-udist 7 '' '偏移距离<或直接量取>:' OF nil))

(while (setq ss (ssget':s' '((0 . '*TEXT'))))

(setq i -1)

(while (setq txtEntName (ssname ss (setq i (1+ i))))

(vl-cmdf 'ucs' 'Object' txtEntName)

(setq txtEntData (entget txtEntName))

(setq tBox (textbox (list (car txtEntData)))

Pt_BL (car tBox)

PtTR (cadr tBox)

PtTL (list (car Pt_BL) (cadr PtTR));矩形起点

Pt_BR (list (car PtTR) (cadr Pt_BL));矩形对角点

Pt_MC(polar Pt_BL(angle Pt_BL PtTR)

(/ (distance Pt_BL PtTR) 2.0)

);文本的中点

)

(setq Pt_BL(polar Pt_BL PI OF))

(setq Pt_BL(polar Pt_BL (* PI 1.5) OF))

(setq Pt_BR(polar Pt_BR 0.0 OF))

(setq Pt_BR(polar Pt_BR (* PI 1.5) OF))

(setq PtTL (polar PtTL PI OF))

(setq PtTL (polar PtTL (* PI 0.5) OF))

(setq PtTR (polar PtTR 0.0 OF))

(setq PtTR (polar PtTR (* PI 0.5) OF))

(vl-cmdf '_PLine' 'non' Pt_BL 'non' Pt_BR 'non' PtTR 'non' PtTL 'C')

(vl-cmdf 'ucs' 'p');恢复原有坐标

)

(PRINC)

)

通用函数：

(defun KX-udist (bit kwd msg def bpt / inp)

(if def

(setq msg (strcat ' -->请确定' msg '<' (rtos def) '>：')

bit (* 2 (fix (/ bit 2)))

)

(setq msg (strcat ' -->请确定' msg '：'))

)

(initget bit kwd)

(setq inp

(if bpt

(getdist msg bpt)

(getdist msg)

)

(if inp

inp

def

)

;;;*****文字加框程序结束*****

同行连字

;;;*****同行连字程序开始*****

(defun c:thlz(/ ss i ename dl ell x text e1 e2)

(setq ss (ssget '((0 . 'TEXT')))

i 0

dl nil

minx nil

);setq

(if ss

(progn

(repeat (sslength ss)

(setq ename (ssname ss i)

ell (entget ename)

x (cadr (assoc 10 ell))

text (cdr (assoc 1 ell))

i (1+ i)

);setq

(setq dl (append dl (list (list x text ename))))

);repeat

(setq dl (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))

i 1

text (cadr (nth 0 dl))

ename (caddr (nth 0 dl))

ell (entget ename)

);setq

(repeat (- (length dl) 1)

(setq text (strcat text (cadr (nth i dl))))

(entdel (caddr (nth i dl)))

(setq i (1+ i))

);repeat

(setq ell (subst (cons 1 text) (assoc 1 ell) ell))

(entmod ell)

(entupd ename)

);progn

(princ ' 未选中任何文字！')

);if

(princ)

)

;;;*****同行连字程序结束*****

统一字高

;;;*****统一字高程序开始*****

(defun C:tyzg (/ a b n ss aa ss1 h)

(setq ss (ssget))

(setq loop T)

(setq n 0)

(while loop

(setq h (getstring ' 请输入新文本高度[选取对象(S)][选取两点(D)]:'))

(cond ((or (= h 's') (= h 'S'))

(while loop

(princ ' 选取文字:')

(setq ss1 (entsel))

(if (= ss1 nil)

(progn

(princ ' 选取文字:')

(setq loop t)

)

(progn

(setq ss2 (entget (car ss1)))

(setq aa (cdr (assoc 0 ss2)))

(if (or (= 'TEXT' aa) (= 'MTEXT' aa))

(progn

(setq h (cdr (assoc 40 ss2)))

(setq loop nil)

)

((numberp (read h))

(setq h (atof h)

loop nil

)

((or (= h 'd') (= h 'D'))

(progn

(setq h (getdist ' 请选取两点:'))

(setq loop nil)

)

(setq loop T)

)

(repeat (sslength ss)

(setq a (ssname ss n))

(setq b (entget a))

(if (or (= 'TEXT' (cdr (assoc 0 b))) (= 'MTEXT' (cdr (assoc 0 b))) )

(progn

(setq b (subst (cons 40 h) (assoc 40 b) b))

(if (= 3 (cdr (assoc 72 b)))

(setq b (subst (cons 72 0) (assoc 72 b) b))

)

(entmod b)

)

(setq n (1+ n))

)

(print '文字高度已改为：')

(print h)

)

(princ)

)

;;;*****统一字高程序结束*****

等行对齐

;;;*****等行对齐程序开始*****

(defun c:wzdq ()

(setq a (ssget (list (cons 0 'text'))))

(setq n (sslength a))

(setq all nil)

(setq m 0)

(while (< m n)

(setq all (append all (list (entget (ssname a m)))))

(setq m (1+ m))

)

(setq l 0);按y坐标降序排列

(setq m 1)

(while (< l n)

(setq b (nth l all))

(while (< m n)

(setq c (nth m all))

(if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))

(progn

(setq all (subst 'aa (nth l all) all ) )

(setq all (subst 'bb (nth m all) all ) )

(setq all (subst c 'aa all ) )

(setq all (subst b 'bb all ) )

(setq b c)

)

(setq m (1+ m))

)

(setq l (1+ l))

(setq m (1+ l))

)

(setq val (getdist ' 行距：'))

(setq p (getpoint ' 首行的插入点：'))

(setq x0 (car p))

(setq y0 (cadr p))

(setq m 0)

(while (< m n)

(setq b (nth m all))

(setq y (- y0 (* m val)))

(setq z (nth 3 (assoc '10 b)))

(setq xyz_new (list '10 x0 y z))

(setq b (subst (cons '72 0) (assoc '72 b) b))

(setq b (subst (cons '73 0) (assoc '73 b) b))

(setq b (subst xyz_new (assoc '10 b) b ) )

(entmod b)

(setq m (1+ m))

)

(princ ' ＝＝左对齐单行文本，自定义行距程序成功加载！命令行以wzdq启动！')

;;;*****等行对齐程序结束*****

暴强刷子

;;;*****暴强刷子程序开始*****

(defun f:vl-property-available (en)

(setq en (f:enx en))

(vl-remove-if-not

(function (lambda (x) (vlax-property-available-p en x t)))

(f:vla-getlist)

)

(defun f:vla-getlist ()

(cond

(*vla-getlist*)

((setq *vla-getlist*

(mapcar (function (lambda (x) (substr x 9)))

(vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) 'VLA-GET-*'))) (atoms-family 1))

)

) ;setq

)

(defun f:vla-methodlist ()

(cond

(*vla-methodlist*)

((setq *vla-methodlist*

(mapcar (function (lambda (x) (substr x 5)))

(vl-remove-if-not

(function (lambda (x)

(and

(wcmatch (strcase x) 'VLA-*')

(not (wcmatch (strcase x) 'VLA-GET-*,VLA-PUT-*'))

) ;and

)

(atoms-family 1)

)

) ;setq

)

) ;cond

)

(defun f:vl-method-applicable (en)

(setq en (f:enx en))

(vl-remove-if-not

(function (lambda (x) (vlax-method-applicable-p en x)))

(f:vla-methodlist)

)

(defun f:enx (en)

(if (= (type en) 'ENAME)

(vlax-ename->vla-object en)

)

;;==============================================================

;;产生动态对话框,用户供选择 wkai

;;==============================================================

(defun zf:get_properties (e pl / DCL_NAME E F FLAG INDEX_VALUE PL1 VAR pl2 pl0 )

;;;======================================================

(defun zf:format_str (a b)

(print a)

(princ ' ')

(princ (type a))

(setq a (vl-princ-to-string a))

(if (> (strlen a) b)

(setq a (strcat (substr a 1 (- b 1)) '.'))

(repeat (- b (strlen a) ) (setq a (strcat a ' ')))

)

;;;======================================================

(defun zf:check_toggles ()

(foreach n pl0

(if (= '1' (get_tile (vl-princ-to-string (if (listp n)(car n)n))))

(setq pl2 (cons (if (listp n)(car n)n) pl2))

)

(done_dialog 1)

)

;;;======================================================

(defun zf:selectall (str pl1 / mode)

(setq mode (get_tile str))

(foreach n pl1

(set_tile (vl-princ-to-string (if (listp n)(car n)n)) mode)

)

;;;======================================================

(defun zf:get_rows(n / lst)

(cond

((< n 6)(setq b 1))

((< n 18)(setq b 2))

(t(setq b 3))

)

(setq c (1+ (fix (/ n b 1.0)))

m 1

)

(while (<= m c)

(setq r (rem n m))

(if (or (= r 0)(> r (* 0.7 m)))(setq lst (cons m lst) ))

(setq m (1+ m))

)

(car lst)

)

;;;======================================================

(if (= 'ENAME (type e))

(setq e (vlax-ename->vla-object e))

)

(setq pl (f:vl-property-available e))

(foreach n pl

(if (not (vl-catch-all-error-p

(setq var (vl-catch-all-apply

'vlax-get-property

(list e (if (listp n)(car n)n))

)

(setq pl0 (cons n pl0))

)

(setq pl0 (mapcar 'read (vl-sort pl0 '<)))

(setq pl1 pl0)

(setq pl '((color '颜色')

(layer '图层')

(linetype '线型')

(lineweight '线宽')

(LinetypeScale '线型比例')

(PlotStyleName '打印样式')

) ;_ 此处可根据需要增减

)

(foreach n pl

(setq pl1 (vl-remove (car n) pl1) )

)

(setq m 0

o (zf:get_rows (length pl1))

)

(or o (setq o 20) )

(setq oo (fix(/ (length pl1) o 1.0) ))

(if(>(rem (length pl1) o )0)(setq oo (1+ oo)))

(setq oo (cadr (assoc oo '((1 6)(2 3)(3 2)(4 2)(5 2)(6 1)))))

(or oo (setq oo 1))

(setq DCL_NAME (getvar 'TEMPPREFIX'))

(setq dcl_name (strcat dcl_name 'easy_matchprop' '.dcl'))

(SETQ f (OPEN dcl_name 'w'))

(write-line

(strcat 'ss:dialog{label=''

(vlax-get-property e 'ObjectName)

'';'

)

(write-line

':boxed_row{label='Public Props'; :column{'

)

(foreach n pl

(setq m (1+ m))

(if (> m oo)

(progn (setq m 1) (write-line '} :column{' f))

)

(write-line

(strcat ':toggle{label=''

(zf:format_str

(if (listp n)

(cadr n)

)

':'

(zf:format_str

(vlax-get-property

(if (listp n)

(car n)

)

'';key=''

(vl-princ-to-string

(if (listp n)

(car n)

)

'';}'

)

(repeat (- oo m)(write-line ':spacer{}' f))

(write-line '}}:boxed_row{label='Private Props'; :column{' f)

(setq m 0)

(foreach n pl1

(setq m (1+ m))

(if (> m o)

(progn (setq m 1) (write-line '} :column{' f))

)

(write-line

(strcat ':toggle{label=''

(zf:format_str (if (listp n)(cadr n)n)15)':' (zf:format_str (vlax-get-property e (if (listp n)(car n)n))15)

'';key=''

(vl-princ-to-string (if (listp n)(car n)n))

'';}'

)

(repeat (- o m)(write-line ':spacer{}' f))

(write-line '}}:row{:toggle{label='Public Props';key='selectall';}:toggle{label='Private Props';key='selectall1';}ok_only;}}' f)

(close f)

(setq index_value (load_dialog dcl_name))

(new_dialog 'ss' index_value)

(action_tile 'selectall' '(zf:selectall 'selectall' pl)')

(action_tile 'selectall1' '(zf:selectall 'selectall1' pl1)')

(action_tile 'accept' '(zf:check_toggles)')

(setq flag (start_dialog))

(unload_dialog index_value)

(print pl2)

pl2

)

;;==============================================================

;;改特性的一种通用编程方法，变量名称使用特性名，用 eval 求值

;;==============================================================

(defun ea:put-property (obj plst /)

(mapcar '(lambda (p)

(if (eval p)

(vl-catch-all-apply

'vlax-put-property

(list obj p (eval p))

)

plst

)

;;==============================================================

;;示例

;;用上面的函数可以做出比CAD更最强劲的并可以自由定制的刷子

;; pl 中需要的特性参考联机帮助中各实体 Properties

;;==============================================================

(vl-load-com)

(defun c:mat (/ e ss obj pl olderr myerr eDoc)

(defun myerr (msg)

(if (/= msg '取消')

(princ ' *取消*')

)

(if pl

(progn

(mapcar '(lambda (x) (set x nil)) pl)

(setq pl nil)

)

(vla-endundomark eDoc)

(setq *error* olderr)

(princ)

)

(setq eDoc (vlax-get-property (vlax-get-acad-object) 'activedocument))

(vla-startundomark eDoc)

(setq olderr *error*

*error* myerr

)

(if (and (setq e (car (entsel ' 选择源对象: ')))

(setq pl (zf:get_properties e pl))

(progn

(princ ' 选择目标对象....')

(setq ss (ssget))

)

(progn

(setq obj (vlax-ename->vla-object e))

(mapcar '(lambda (p / var)

(if (not (vl-catch-all-error-p

(setq var (vl-catch-all-apply

'vlax-get-property

(list obj p)

)

(set p var)

(set p nil)

)

(setq ssl (sslength ss))

(while (> ssl 0)

(setq

obj (vlax-ename->vla-object (ssname ss (setq ssl (1- ssl))))

)

(ea:put-property obj pl)

)

(mapcar '(lambda (x) (set x nil)) pl)

(setq pl nil)

)

(setq *error* olderr)

(vla-endundomark eDoc)

(princ)

)

(princ ' Writen By Eachy , From [url]www.xdcad.net[/url]!')

(princ ' Modified By Wkai , From [url]www.xdcad.net[/url]!')

(princ ' 启动命令: mat')

(princ)

;;;*****暴强刷子程序结束*****

字体宽度

;;;*****字体宽度程序开始*****

(Defun c:ztkd ( / fil sc scl len n e ed h)

(command 'redraw')

(setq fil (ssget))

( setq sc (getreal ' 请输入宽度比例：'))

( setq scl sc)

(setq len (sslength fil))

(setq n 0)

(while (<= n (- len 1))

(progn

(setq e (ssname fil n))

(if (= 'TEXT' (cdr (assoc 0 (setq ed (entget e)))))

(progn

(setq h scl)

(setq ed (subst (cons 41 h) (assoc 41 ed) ed))

(setq n (+ 1 n))

(entmod ed)

)

(setq n (+ 1 n))

)

(princ)

)

(princ)

;;;*****字体宽度程序结束*****

自动建层

;;;*****自动建层程序开始*****

(defun c:zdjc ()

(setvar 'cmdecho' 0)

(command 'layer' 'm' 'sd深度' 'c' '7' '' '')

(command 'layer' 'm' 'qb强标' 'c' '3' '' '')

(command 'layer' 'm' 'qt强条' 'c' '6' '' '')

(princ)

)

;;;*****自动建层程序结束*****

当前图层

;;;*****当前图层程序开始*****

(defun c:dq (/ ent ent_data clay olay)

(setq olay (getvar 'clayer'))

(setq ent (car (entsel (strcat ' 选择物体/当前层为<' olay '>:'))))

(if (/= nil ent)

(progn

(setq ent_data (entget ent))

(setq clay (cdr (assoc 8 ent_data)))

(setvar 'clayer' clay)

(prompt (strcat ' 成功将图层设为<' clay '>：'))

)

;;;*****当前图层程序结束*****

图层全开

;;;*****图层全开程序开始*****

(defun c:qk nil (princ ' 打开全部图层')(command 'LAYER' 'ON' '*' ''))

;;;*****图层全开程序结束*****

框选关层

;;;*****框选关层程序开始*****

(DEFUN C:OL ()

(setvar 'cmdecho' 0)

(prompt' 请选择要关闭的图层上的对象')

(setq ss (ssget))

(if (and ss (sslength ss) 0)

(progn

(setq ct 0 len (sslength ss) cl (getvar 'clayer'))

(command '.layer')

(while (< ct len)

(setq la (cdr (assoc 8 (entget (ssname ss ct)))))

(if (/= cl la)(command 'off' la)

(progn (prompt ' 你选择的层:')

(prompt la)

(prompt ' 是当前层，不能关闭')

) ;end of progn

) ;end of if

(if (= old nil)(setq OLD la)(setq OLD (strcat OLD ',' la)))

(setq ct (1+ ct))

) ;end of while

(command'')

) ;end of progn

) ;end of if

(princ)

(setvar 'cmdecho' 0) (prin1)

)

;;;*****框选关层程序结束*****

非选关层

;;;*****非选关层程序开始*****

(defun c:Lf (/ ENS I LAY LAY_LST LAY_STR LENG OLDCMDE)

(if (setq ens (ssget))

(progn

(setq oldcmde (getvar 'cmdecho'))

(setvar 'cmdecho' 0)

(setq leng (sslength ens) i 0)

(repeat leng

(setq lay (cdr (assoc 8 (entget (ssname ens i)))))

(if (Not (member lay lay_lst)) (setq Lay_Lst (cons lay Lay_Lst)))

(setq i (1+ i))

)

(setq lay_str '')

(foreach n Lay_Lst (setq lay_str (strcat lay_str ',' n)))

(setq lay_str (vl-string-trim ',' lay_str))

(command '_.layer' 'off' '*' 'y' 'on' lay_str '')

(setvar 'cmdecho' oldcmde)

)

(prin1)

)

;;;*****非选关层程序结束*****

(defun c:aq(/ x)

(setvar 'CMDECHO' 0)

(if (progn (princ ' Select Layer to be unlocked:')

(setq ss (ssget))) (progn

(setq n 0)

(repeat (sslength ss)

(setq ln (cdr(assoc 8 (entget(ssname ss n))))

n (1+ n))

(command 'layer' 'unlock' ln '')

)

))

(setvar 'CMDECHO' 1)

(princ)

)

非选锁层

;;;*****非选锁层程序开始*****

(defun c:uk(/ x)

(setvar 'CMDECHO' 0)

(command 'layer' 'Lo' '*' '')

(if (progn (princ ' Select Layer to be unlocked:')

(setq ss (ssget))) (progn

(setq n 0)

(repeat (sslength ss)

(setq ln (cdr(assoc 8 (entget(ssname ss n))))

n (1+ n))

(command 'layer' 'unlock' ln '')

)

))

(setvar 'CMDECHO' 1)

(princ ' 仅解锁选定图元所在图层，锁住其他图层')

(princ )

)

;;;*****非选锁层程序结束*****

全部解锁

;;;*****全部解锁程序开始*****

(defun c:uu ()

(setvar 'CMDECHO' 0)

(command 'layer' 'u' '*' '')

(setvar 'CMDECHO' 1)

(princ ' 解锁所有图层')

(princ )

)

;;;*****全部解锁程序结束*****

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(PROMPT ' *****************阳羡刚刚好工具箱已加载*******************')

(PROMPT' **************>>主面板命令yyg<<******************')

(princ)

文章为用户上传，仅供非商业浏览。发布者：Lomu，转转请注明出处： https://www.daogebangong.com/articles/detail/20221011%20Welfare%20post%20Integrate%20your%20commonly%20used%20commands%20into%20a%20selfuse%20panel%20in%20CAD%20for%20easy%20calling.html