属性刷程序改进
本帖最后由 andyding 于 2019-7-4 15:35 编辑请各位大侠出手帮忙，悬赏只是一点心意。附件属性刷程序，我的块属性项太多，150项，对话框太长，屏幕显示不下。
希望改成类似院长图片那样的，要源码。
;;最后编辑20190721
(defun c:ATF( );此部分是测试代码用
(Cq-GetFrameAttributes)
(if bln(属性块_load))
)
;;;格式化entsel选不中接着选，空格，右键退出。
(defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred))
(while
(progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, Try again.")
)
( (eq 'STR (type sel))
nil
)
( (vl-consp sel)
(if (and pred (not (pred sel)))
(princ "\nInvalid Object Selected.")
)
)
)
)
)
sel
)
;;;lisp对象名转vla对象名
(defun Cq-en-vl (ename / Vlaobj )
(setq Vlaobj(vlax-ename->vla-objectEname))
Vlaobj
);end Defun CQ-en-vl
;;选择集与对象名表互转
(defun Cq-S2E (ss / enlst)
(cond
((= (type ss) 'PICKSET) ;;判断符号是否为选择集
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss)))
) ;_选择集变表
((= (type ss) 'LIST) ;;判断符号是否为表
(setq enlst (ssadd)) ;;建立空选择集
(foreach en ss (ssadd en enlst));;图元名称添加至选择集enlst
) ;_表变选择集
)
);END DEFUN
;;子程序
;匹配属性块信息
(defun Cq-GetFrameAttributes ( /)
(setq sel(LM:SelectIf "\n选取源属性块: "(lambda(x)(=(cdr(assoc 66(entget(car x))))1 )) entsel nil))
(if sel
(progn
(setq bln (cdr(assoc 2 (entget(car sel)))))
(setq Tags nil Textstr nil)
(setq blk (vlax-Ename->vla-Object (car sel)))
(if (= (vla-Get-HasAttributes blk) :vlax-true);判断是否有属性
(foreach n (vlax-SafeArray->list(vlax-Variant-Value (vla-GetAttributes blk)));属性集合
(setq Tags(cons(vla-Get-TagString n)Tags))
(setq Textstr(cons(vla-Get-TextString n)Textstr))
)
)
)
)
(setq i (length Tags) Text_lst nil Check_lst nil Texts nil Checks nil)
(repeat i
(setq Text_lst(cons(strcat "text" (itoa i) "_bak20180503")Text_lst))
(setq Check_lst(cons(strcat "check" (itoa i) "_bak20180503")Check_lst))
(setq Texts(cons(strcat "text" (itoa i))Texts))
(setq Checks(cons(strcat "check" (itoa i))Checks))
(setq i(1- i))
)
(Mapcar '(lambda(a b)(set (read a) b)) Text_lst (reverse Textstr))
;;--------初始化check#去nil---------------
(foreach n Check_lst
(if (not (eval(read n)))(set (read n) "0"))
)
;;参考
;;Check2_bak20180503
;;Text2_bak20180503
(setq i (length Tags) dcl_Check nil dcl_Text nil dcl_check_text nil)
(setq rows (cond((< 60 i )30)(15)))
(foreach n Tags
;;--------定义复选框Dcl代码---------------
(if (= rows (gcd rows i))
(progn
(setq dcl_check_text
(cons
(append
dcl_check
'(
"}"
":column"
"{"
)
dcl_text
)
(cons
'(
"}"
":column"
"{"
)
dcl_check_text
)
)
)
(setq dcl_check nil dcl_text nil)
)
)
(setq dcl_check
(cons
(strcat
":toggle"
"{"
"key = \"check" (itoa i) "\" ;"
"label = \" " n "：\" ;"
"height = 0.5 ;"
"}"
)
dcl_check
)
)
;;--------定义文本框Dcl代码---------------
(setq dcl_text
(cons
(strcat
":edit_box"
"{"
"key = \"text" (itoa i) "\" ;"
"width= 20 ;"
"height = 0.5 ;"
"}"
)
dcl_text
)
)
(setq i(1- i))
)
(setq dcl_check_text
(cons
(append
dcl_check
'(
"}"
":column"
"{"
)
dcl_text
)
(cons
'(
"}"
":column"
"{"
)
dcl_check_text
)
)
)
(princ)
)
;;子程序
;;;勾选属性修改
(defun Cq-PutAttributes (ss / )
(if ss
(progn
(setq enlst(cq-s2e ss))
(if (equal "1" all_sel)
(foreach en enlst
(MJ:ChangeAttributes (cons en (Mapcar 'cons (reverse Tags) (Mapcar 'eval(Mapcar 'read Text_lst)))))
);for 全选
(foreach en enlst
(setq i 0)
(foreach Check Check_lst
(if (= "1" (eval (read Check))) (MJ:PutTagTextStringByRef (cq-en-vl en) (nth i (reverse Tags)) (eval(read(nth i Text_lst)))))
(setq i(1+ i))
)
);for 勾选
);if "1" all_sel
);progn
);if ss
(princ)
); defun
(defun 属性块_load( / )
(vl-load-com)
;;设置对话框位置
(if (not #dlg_pnt20180503)
(setq #dlg_pnt20180503 '(-1 -1))
);if
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl_属性块))));对话框加载
(vl-file-delete Dcl_File);加载后删除DCL文件
(setq Dialog_Return 2)
(while (> Dialog_Return 1) ;循环控制对话框是否结束
(new_dialog "属性块" dcl_id "" #dlg_pnt20180503);建立窗体
;-->-->-对话框初始化->-->--
(setq keys (append checks texts'("check0" "command1" "command2" "command3" "accept" "cancel")));列表全部控件名称
(foreach key keys;全部控件的初始化1
(if (eval (read (strcat key "_bak20180503"))) (set_tile key (eval (read (strcat key "_bak20180503")))));控件内容
(action_tile key "(Action_属性块_Keys $key $value)");点击动作
)
;-------设置文本框状态------
(setq i 0)
(foreach nchecks
(if (equal (eval(read(strcat n "_bak20180503"))) "0") (mode_tile (nth i texts) 1) (mode_tile (nth i texts) 0))
(setq i (1+ i))
)
;--<--<-对话框初始化完成-<--<--
(setq Dialog_Return (start_dialog));开启对话框(用户可见)
;-->-->-LPACMQ加入按键功能>>>>>>>
(cond
((= Dialog_Return 3)
(C:ATF)
(unload_dialog dcl_id)
)
((= Dialog_Return 4)
(princ "\n★修改块参照属性")
(Cq-PutAttributes
(setq ss(ssget (list '(0 . "INSERT")'(-4 . "<OR")(cons 2 bln)(cons 2 "*FRAME*")'(-4 . "OR>"))))
)
)
);cond
;--<--<-LPACMQ按键功能完成<<<<<<<
);While
(unload_dialog dcl_id);退出时卸载对话框
(princ);防止函数回显
)
(defun Action_属性块_Keys (key value / ) ;全部控件的点击动作触发
(eval
(append
'(cond((= key "accept") ;{确认按钮}
(Get_属性块_Data)
;;保存对话框位置坐标 -by LPACMQ 2015-6-8
(setq #dlg_pnt20180503 (done_dialog 1));对话框退出返回主函数 传递给Dialog_Return值为1
)
((= key "cancel") ;{取消按钮}
(done_dialog 0);对话框退出返回主函数 传递给Dialog_Return值为0
)
)
;参考
; ((= key "check1")(if (equal "0" $value )(progn (mode_tile "text1" 1) (set_tile "check0" "0")) (mode_tile "text1" 0)))
(mapcar '(lambda(a b)
(read
(strcat "((= key "
(vl-prin1-to-string(eval a))
")(if (equal \"0\" $value)(progn(mode_tile "
(vl-prin1-to-string(eval b))
" 1)(set_tile \"check0\" \"0\"))(mode_tile "
(vl-prin1-to-string(eval b)) " 0)))"
)
)
)
checks texts
)
'(((= key "check0") ; {"全选"} (多选按钮)
(cond
((equal "1" $value )
(foreach n checks (set_tile n "1"))
(foreach n texts (mode_tile n 0))
)
((equal "0" $value )
(foreach n checks (set_tile n "0"))
(foreach n texts (mode_tile n 1))
)
)
)
((= key "command3") ; {"默认"} (按钮)
;;先清零
(set_tile "check0" "0")
(foreach n checks (set_tile n "0"))
(foreach n texts (mode_tile n 1))
;;默认配置
(progn (mode_tile "text1" 0) (set_tile "check1" "1"))
(progn (mode_tile "text2" 0) (set_tile "check2" "1"))
(progn (mode_tile "text3" 0) (set_tile "check3" "1"))
(progn (mode_tile "text4" 0) (set_tile "check4" "1"))
(progn (mode_tile "text5" 0) (set_tile "check5" "1"))
; (progn (mode_tile "text6" 0) (set_tile "check6" "1"))
; (progn (mode_tile "text7" 0) (set_tile "check7" "1"))
(progn (mode_tile "text8" 0) (set_tile "check8" "1"))
(progn (mode_tile "text9" 0) (set_tile "check9" "1"))
(progn (mode_tile "text10" 0) (set_tile "check10" "1"))
; (progn (mode_tile "text11" 0) (set_tile "check11" "1"))
(progn (mode_tile "text12" 0) (set_tile "check12" "1"))
; (progn (mode_tile "text13" 0) (set_tile "check13" "1"))
(Get_属性块_Data)
)
((= key "command1") ; {"匹配"} (按钮)
(Get_属性块_Data)
(done_dialog 3);3
)
((= key "command2") ; {"修改"} (按钮)
(setq all_sel (get_tile "check0"))
(Get_属性块_Data)
(done_dialog 4)
)
)
);Append
);eval
)
(defun Get_属性块_Data( / );临时生成Dcl文件 返回文件名
(foreach key keys
(set (read (strcat key "_bak20180503")) (get_tile key));每个控件都赋给一个变量 用于下次开启初始化
)
)
(defun Write_Dcl_属性块( / )
(defun *error* (msg)
(princ "出错: 对不起")
(princ msg)
(princ)
)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "w"))
(foreach str (append
(list
"属性块:dialog"
"{"
" label = \" 属性块编辑工具v1.0 \";"
" :row" ;column
" {"
" :boxed_column"
" {"
(strcat " label = \"块名：" bln "\" ;")
" :row"
" {"
" :column"
" {"
)
(apply 'append dcl_check_text)
'(
" }"
" :column"
" {"
" :toggle"
" {"
" key = \"check0\" ;"
" label = \"全选\" ;"
" width = 0.5 ;"
" height = 0.5 ;"
" }"
" :button"
" {"
" key = \"command3\" ;"
" label = \"默认\" ;"
" width = 0.5 ;"
" height = 2.5 ;"
" }"
" :button"
" {"
" key = \"command1\" ;"
" label = \"匹配\" ;"
" width = 0.5 ;"
" height = 5 ;"
" }"
" :button"
" {"
" key = \"command2\" ;"
" label = \"修改\" ;"
" width = 0.5 ;"
" height = 10 ;"
" }"
" }"
" }"
" }"
" }"
"ok_cancel ;"
"}"
)
);append
(write-line str file)
)
(close file)
Dcl_File
)
;;30.2 [功能] 更改选定块的指定属性
;; (MJ:PutTagTextStringByRef (*En2Obj* (car (entsel))) "设计" "new value")
(defun MJ:PutTagTextStringByRef (br tagname textstring / atts tag)
(if (and
(= (vla-get-hasattributes br) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes br)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-TextString tag textstring)
)
)
(vla-update br)
)
)
;;30.3 [功能] 更改块多个属性
;;(setq blk (car (entsel)))
;;(MJ:ChangeAttributes (list blk (cons "设计" "AA")(cons "名称" "BB")))
(defun MJ:ChangeAttributes (lst / atts blk item)
(setq blk (vlax-Ename->vla-Object (car lst))
lst (cdr lst)
)
(if (= (vla-Get-HasAttributes blk) :vlax-true) ;如果有属性
(progn
(setq atts (vlax-SafeArray->list
(vlax-Variant-Value (vla-GetAttributes blk))
)
)
(foreach item lst
(mapcar
'(lambda (x)
(if
(= (strcase (car item)) (strcase (vla-Get-TagString x)))
(vla-Put-TextString x (cdr item))
)
)
atts
)
)
(vla-Update blk)
)
)
)
帖不要沉啊。 150个确实多，可以考虑做成翻页的，类似ATE命令 没有样板块怎么搞 高手不屑搞
新手搞不定
这个主要有点耗时间尴尬了 qq1254582201 发表于 2019-7-6 12:27
没有样板块怎么搞
这个不需要样板的，自己随便做一个都可以。 taoyi0727 发表于 2019-7-6 13:31
高手不屑搞
新手搞不定
这个主要有点耗时间尴尬了
确实有点:( 你这个就是要重新做面板要做动态的面板我就是个半桶水,不好弄 taoyi0727 发表于 2019-7-6 16:06
你这个就是要重新做面板要做动态的面板我就是个半桶水,不好弄
固定面板也可以,刷属性少的块, 灰色一大片都没有关系