半听可乐 发表于 2013-12-8 10:32 static/image/common/back.gif
大侠们一下子奉献了这么多的好作品，小弟略晕，Z版主这点睛之笔是要画在哪里呢？
DCL及fas编译版出炉。。。
;;;批量改文字高度及圆直径DCL版 by edata@2013.12.8
;;;命令默认ty 可以自定义命令
;;;dcl部分小菜选择图层多选dcl
;;;修改圆及文字采用zzxxqq版主简练语句
;;;加入出错处理
;出错函数
(defun *error*_New1 (msg)
(if *error*_Old (setq *error* *error*_Old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(princ "*取消*")
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
;对话框处理函数
(defun get_lay(/ lays lay_lst x f dcl_name DCL_ID S_D b B tmp lst1 txth1 dr1)
(vlax-map-collection (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) '(lambda (x) (setq lay_lst (cons (vla-get-name x) lay_lst))))
(setq lays "" lay_lst (mapcar 'vl-princ-to-string lay_lst))
(setq dcl_name (strcat (getenv "temp") "\\sel_lay" ".dcl")
f (OPEN dcl_name "w"))
(write-line (strcat "sel_lay:dialog {label=\"批量改文字高度及圆直径DCL版 by edata@2013.12.8\";spacer;:row{
:column {children_alignment = top ;fixed_height = true ;label = \"设置\" ;:edit_box {label = \"文字高度\" ; key=\"key_h\";}:edit_box {label = \"圆形直径\" ;
key=\"key_rr\";}spacer; :text{fixed_height = true ;fixed_width = true ;height = 10 ;
value = \"Ctrl+鼠标左键=跳选;\\nCtrl+左键单击选中=取消;\\nShift+鼠标左键=连选;\\n鼠标左键拖动=连选; \\n鼠标双击=单选执行;\\n鼠标双击列表空白=执行;\\n默认全选图层.\" ;width = 26 ;}}
:list_box {label=\"选择图层(多选)\"; key=\"lay_sel\"; height=30; width=30; fixed_width=true; fixed_height=true;
alignment=centered; multiple_select=true; allow_accept=true;}} spacer; ok_cancel;}") f)
(close f)
(setq DCL_ID (load_dialog dcl_name))
(new_dialog "sel_lay" DCL_ID)
(start_list "lay_sel")
(mapcar 'add_list lay_lst)
(end_list)
(if sk_txth (set_tile "key_h" (rtos sk_txth 2 2)))
(if sk_dr (set_tile "key_rr" (rtos sk_dr 2 2)))
(action_tile "lay_sel""(setq b $value)(setq txth1 (get_tile \"key_h\"))(setq dr1 (get_tile \"key_rr\")) (if (= $reason 4) (done_dialog 1))" )
(action_tile "lay_sel" "(setq b $value)(setq txth1 (get_tile \"key_h\"))(setq dr1 (get_tile \"key_rr\"))")
(action_tile "accept" "(setq txth1 (get_tile \"key_h\"))(setq dr1 (get_tile \"key_rr\"))(done_dialog 1)")
(action_tile "cancel" "(done_dialog)(exit)")
(setq S_D (start_dialog))
(unload_dialog DCL_ID)
(if (and (= S_D 1) B)
(progn
(foreach tmp (setq lst1 (read (strcat "(" B ")")))
(setq lays (strcat lays "," (nth tmp lay_lst)))
)
)
)
(if (and txth1 dr1)(list lays txth1 dr1)(list lays))
)
;主函数
(defun sk_ty(/ ss en e lay_lst dc_lst f_lst)
(vla-startUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq *error*_Old *error*)
(setq *error* *error*_New1)
(or sk_dr (setq sk_dr 150))
(or sk_txth (setq sk_txth 300))
(setq dc_lst(get_lay))
(setq lay_lst(car dc_lst))
(if (and dc_lst (= (length dc_lst) 3))(progn (setq sk_txth(atof(cadr dc_lst)))(setq sk_dr(atof(caddr dc_lst)))))
(setq f_lst(list(cons 0 "*text,circle")))
(if (and lay_lst (/= lay_lst "")) (setq f_lst(cons (cons 8 lay_lst)f_lst)))
(prompt "\n请选择需要统一直径与字高的圆、文字(ESC取消):")
(if (setq ss(ssget f_lst))
(progn
(while (setq en(ssname ss 0))
(setq e(entget en))
;;;zzxxqq版主简写代码
(entmod (subst (cons 40 (if (= (cdr(assoc 0 e)) "CIRCLE" ) (* sk_dr 0.5) sk_txth)) (assoc 40 e) e))
(setq ss(ssdel en ss))
)
)
(princ "\n 没有选中对象 !!!")
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(if *error*_Old (setq *error* *error*_Old))
(princ)
)
;自定义命令修改
(defun c:ty()(sk_ty))
(vl-load-com)
(prompt"\n批量改文字高度及圆直径DCL版 命令 ty ")
(princ)
edata 发表于 2013-12-8 14:56 static/image/common/back.gif
DCL及fas编译版出炉。。。
越来越高级了，但我还是希望能够预先定义一些图层，因为我图纸里的图层太多了，在列表里选择图层有些困难。其实你的第一个程序就够用了，这个要求有些吹毛求疵，主要就是想在图层全开的情况下框选大量图元然后程序能对预定义图层上的图元自动执行，其实这个功能完全可以通过先过滤图层，然后使用你的原始版程序来实现，既然大侠热心，也可以考虑一下预定义图层而不是在列表里去选择
半听可乐 发表于 2013-12-7 15:59 static/image/common/back.gif
朋友，如果我想增加个图层识别功能怎么改呢？即只希望修改指定图层中的文字和圆，指定的图层在程序中预先 ...
把(ssget '((0 . "*text,circle"))) 替换成:(ssget (list '(0 . "*text,circle") (cons 8 图层名)))
edata 发表于 2013-12-7 20:56 static/image/common/back.gif
DCL及fas编译版出炉。。。
师兄利害
半听可乐 发表于 2013-12-8 15:46 static/image/common/back.gif
越来越高级了，但我还是希望能够预先定义一些图层，因为我图纸里的图层太多了，在列表里选择图层有些困难 ...
预定义图层是固定的吗。
;;;批量改文字高度及圆直径DCL版 by edata@2013.12.8
;;;命令默认ty 可以自定义命令
;;;dcl部分小菜选择图层多选dcl
;;;修改圆及文字采用zzxxqq版主简练语句
;;;加入出错处理
;出错函数
(defun *error*_New1 (msg)
(if *error*_Old (setq *error* *error*_Old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(princ "*取消*")
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
;对话框处理函数
(defun get_lay(/ lays lay_lst x f dcl_name DCL_ID S_D b B tmp lst1 txth1 dr1)
(setq lays "" lay_lst (list
"0" "家电" "工作" "dim" ;替换图层名
))
(setq dcl_name (strcat (getenv "temp") "\\sel_lay" ".dcl")
f (OPEN dcl_name "w"))
(write-line (strcat "sel_lay:dialog {label=\"批量改文字高度及圆直径DCL版 by edata@2013.12.8\";spacer;:row{
:column {children_alignment = top ;fixed_height = true ;label = \"设置\" ;:edit_box {label = \"文字高度\" ; key=\"key_h\";}:edit_box {label = \"圆形直径\" ;
key=\"key_rr\";}spacer; :text{fixed_height = true ;fixed_width = true ;height = 10 ;
value = \"Ctrl+鼠标左键=跳选;\\nCtrl+左键单击选中=取消;\\nShift+鼠标左键=连选;\\n鼠标左键拖动=连选; \\n鼠标双击=单选执行;\\n鼠标双击列表空白=执行;\\n默认全选图层.\" ;width = 26 ;}}
:list_box {label=\"选择图层(多选)\"; key=\"lay_sel\"; height=30; width=30; fixed_width=true; fixed_height=true;
alignment=centered; multiple_select=true; allow_accept=true;}} spacer; ok_cancel;}") f)
(close f)
(setq DCL_ID (load_dialog dcl_name))
(new_dialog "sel_lay" DCL_ID)
(start_list "lay_sel")
(mapcar 'add_list lay_lst)
(end_list)
(if sk_txth (set_tile "key_h" (rtos sk_txth 2 2)))
(if sk_dr (set_tile "key_rr" (rtos sk_dr 2 2)))
(action_tile "accept" "(setq txth1 (get_tile \"key_h\"))(setq dr1 (get_tile \"key_rr\"))(done_dialog 1)")
(action_tile "cancel" "(done_dialog)(exit)")
(setq S_D (start_dialog))
(unload_dialog DCL_ID)
(foreach tmp lay_lst
(setq lays (strcat lays "," tmp))
)
(if (and txth1 dr1)(list lays txth1 dr1)(list lays))
)
;主函数
(defun sk_ty(/ ss en e lay_lst dc_lst f_lst)
(vla-startUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq *error*_Old *error*)
(setq *error* *error*_New1)
(or sk_dr (setq sk_dr 150))
(or sk_txth (setq sk_txth 300))
(setq dc_lst(get_lay))
(setq lay_lst(car dc_lst))
(if (and dc_lst (= (length dc_lst) 3))(progn (setq sk_txth(atof(cadr dc_lst)))(setq sk_dr(atof(caddr dc_lst)))))
(setq f_lst(list(cons 0 "*text,circle")))
(if (and lay_lst (/= lay_lst "")) (setq f_lst(cons (cons 8 lay_lst)f_lst)))
(prompt "\n请选择需要统一直径与字高的圆、文字(ESC取消):")
(if (setq ss(ssget f_lst))
(progn
(while (setq en(ssname ss 0))
(setq e(entget en))
;;;zzxxqq版主简写代码
(entmod (subst (cons 40 (if (= (cdr(assoc 0 e)) "CIRCLE" ) (* sk_dr 0.5) sk_txth)) (assoc 40 e) e))
(setq ss(ssdel en ss))
)
)
(princ "\n 没有选中对象 !!!")
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(if *error*_Old (setq *error* *error*_Old))
(princ)
)
;自定义命令修改
(defun c:ty()(sk_ty))
(vl-load-com)
(prompt"\n批量改文字高度及圆直径DCL版 命令 ty ")
(princ)如果预定是固定的话可以用这个，图层名替换一下。。
半听可乐 发表于 2013-12-8 15:46 static/image/common/back.gif
越来越高级了，但我还是希望能够预先定义一些图层，因为我图纸里的图层太多了，在列表里选择图层有些困难 ...
DCL版本图层更新
图层分为列表和过滤，在过滤列表里将被选择
双击列表图层名将添加或删除图层。
也可以通过选择图形获得图层
------------------------------------
;;;批量改文字高度及圆直径DCL版 by edata@2013.12.8
;;;命令默认ty 可以自定义命令
;;;dcl部分小菜选择图层多选dcl
;;;修改圆及文字采用zzxxqq版主简练语句
;;;加入出错处理
;出错函数
(defun *error*_New1 (msg)
(if *error*_Old (setq *error* *error*_Old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(princ "*取消*")
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
;修改函数
(defun sk_xiugai (sk_txthsk_dr lay_lst / f_lstss en e )
(setq f_lst(list(cons 0 "*text,circle")))
(if (and lay_lst (/= lay_lst "") (/= lay_lst ",")) (setq f_lst(cons (cons 8 lay_lst)f_lst)))
(prompt "\n请选择需要统一直径与字高的圆、文字(ESC取消):")
(if (setq ss(ssget f_lst))
(progn
(while (setq en(ssname ss 0))
(setq e(entget en))
;;;zzxxqq版主简写代码
(entmod (subst (cons 40 (if (= (cdr(assoc 0 e)) "CIRCLE" ) (* sk_dr 0.5) sk_txth)) (assoc 40 e) e))
(setq ss(ssdel en ss))
)
)
(princ "\n 没有选中对象 !!!")
))
;对话框处理函数
(defun get_lay(/ lays lay_lst x f dcl_name DCL_ID S_D b B tmp lst1 txth1 dr1 lays)
(vlax-map-collection (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) '(lambda (x) (setq lay_lst (cons (vla-get-name x) lay_lst))))
(setq lays "" lay_lst (mapcar 'vl-princ-to-string lay_lst))
(setq dcl_name (strcat (getenv "temp") "\\sel_lay" ".dcl")
f (OPEN dcl_name "w"))
(write-line (strcat "sel_lay:dialog {label=\"批量改文字高度及圆直径DCL版V1.3 by edata@2013.12.9\";spacer;:row{
:column {children_alignment = top ;fixed_height = true ;label = \"设置\" ;:edit_box {label = \"文字高度\" ; key=\"key_h\";}:edit_box {label = \"圆形直径\" ;
key=\"key_rr\";}spacer; :text{fixed_height = true ;fixed_width = true ;height = 10 ;
value = \"在图层列表里鼠标双击加入过滤组;\\n在过滤列表双击删除;\\n清空按钮清空过滤;\\n过滤列表空则不过滤图层; \" ;width = 26 ;}}
:column{label=\"选择图层加入过滤\";:list_box { key=\"lay_sel\"; height=30; width=30; fixed_width=true; fixed_height=true;
alignment=centered; multiple_select=false; allow_accept=false;} }
:column{label=\"过滤图层\";:list_box { key=\"lay_sel2\"; height=30; width=30; fixed_width=true; fixed_height=true;
alignment=centered; multiple_select=false; allow_accept=false;} :row{:button {label=\"拾取图形加入>>\";key=\"key_en\";}
:button {label=\"清空\";key=\"key_qc\";}}}} spacer; ok_cancel;}") f)
(close f)
(setq DCL_ID (load_dialog dcl_name))
(new_dialog "sel_lay" DCL_ID)
(start_list "lay_sel")
(mapcar 'add_list lay_lst)
(end_list)
(if n_lays (progn
(start_list "lay_sel2")
(mapcar 'add_list n_lays)
(end_list)))
(if sk_txth (set_tile "key_h" (rtos sk_txth 2 2)))
(if sk_dr (set_tile "key_rr" (rtos sk_dr 2 2)))
(defun delsame (lst)
(if lst
(cons (car lst) (delsame (vl-remove (car lst) lst)))
)
)
(defun sk_addlist(layx k_i / s1 s2)
(or n_lays (setq n_lays '()))
(setq n_lays(cons (nth k_i layx) n_lays))
(setq n_lays(delsame n_lays))
(setq n_lays (vl-sort
n_lays
'(lambda (s1 s2)
(< (car(vl-string->list s1)) (car(vl-string->list s2))))))
(start_list "lay_sel2")
(mapcar 'add_list n_lays)
(end_list)
)
(defun sk_declist(layd k_d / s1 s2)
(or n_lays (setq n_lays '()))
(setq n_lays(vl-remove (nth k_d layd) n_lays))
(setq n_lays(delsame n_lays))
(setq n_lays (vl-sort
n_lays
'(lambda (s1 s2)
(< (car(vl-string->list s1)) (car(vl-string->list s2))) )))
(start_list "lay_sel2")
(mapcar 'add_list n_lays)
(end_list)
)
(defun k_qc()
(setq n_lays '())
(start_list "lay_sel2")
(mapcar 'add_list n_lays)
(end_list)
)
(defun sk_adden(/ ssen enl enlay s1 s2)
(princ "\n选择参考对象:")
(if(setq ssen(ssget))
(progn
(or n_lays(setq n_lays '()))
(while (setq enl(ssname ssen 0))
(setq enlay(cdr (assoc 8 (entget enl))))
(setq n_lays(cons enlay n_lays))
(setq ssen (ssdel enl ssen))
)
(setq n_lays(delsame n_lays))
(setq n_lays (vl-sort
n_lays
'(lambda (s1 s2)
(< (car(vl-string->list s1)) (car(vl-string->list s2))))))
)
)
(get_lay)
)
(action_tile "key_qc" "(k_qc)")
(action_tile "key_en" "(done_dialog 3)")
(action_tile "lay_sel2" "(setq b $value)(sk_declist n_lays (atoi b))")
(action_tile "lay_sel" "(sk_addlist lay_lst (atoi $value))(setq txth1 (get_tile \"key_h\"))(setq dr1 (get_tile \"key_rr\"))")
(action_tile "accept" "(setq txth1 (get_tile \"key_h\"))(setq dr1 (get_tile \"key_rr\"))(done_dialog 1)")
(action_tile "cancel" "(done_dialog)(exit)")
(setq S_D (start_dialog))
(unload_dialog DCL_ID)
(cond
((= S_D 1)(progn (foreach tmp n_lays (setq lays (strcat lays "," tmp)))(sk_xiugai (setq sk_txth(atof txth1))(setq sk_dr(atof dr1)) lays)))
((= S_D 3)(sk_adden))
)
)
;主函数
(defun sk_ty(/ )
(vla-startUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq *error*_Old *error*)
(setq *error* *error*_New1)
(or n_lays (setq n_lays (list "" )))
(or sk_dr (setq sk_dr 150))
(or sk_txth (setq sk_txth 300))
(get_lay)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(if *error*_Old (setq *error* *error*_Old))
(princ)
)
;自定义命令修改
(defun c:ty()(sk_ty))
(vl-load-com)
(prompt"\n批量改文字高度及圆直径DCL版 命令 ty ")
(princ)
edata 发表于 2013-12-8 20:55 static/image/common/back.gif
如果预定是固定的话可以用这个，图层名替换一下。。
大侠，很完美了，非常感谢！这下方便了好多