属性刷程序改进

andyding · 发表于 2019-7-4 15:05

本帖最后由 andyding 于 2019-7-4 15:35 编辑

请各位大侠出手帮忙，悬赏只是一点心意。附件属性刷程序，我的块属性项太多，150项，对话框太长，屏幕显示不下。
希望改成类似院长图片那样的，要源码。

LPACMQ · 发表于 2019-7-4 15:05

;;最后编辑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-object Ename))
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 n checks
(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)
)
)
)

;;最后编辑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-object  Ename)) 
 
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 n  checks 
                       (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) 
    ) 
  )                                
)

andyding · 发表于 2019-7-5 09:11

帖不要沉啊。

LPACMQ · 发表于 2019-7-6 10:40

150个确实多，可以考虑做成翻页的，类似ATE命令

qq1254582201 · 发表于 2019-7-6 12:27

没有样板块怎么搞

taoyi0727 · 发表于 2019-7-6 13:31

高手不屑搞
新手搞不定
这个主要有点耗时间尴尬了

andyding · 发表于 2019-7-6 15:46

qq1254582201 发表于 2019-7-6 12:27
没有样板块怎么搞

这个不需要样板的，自己随便做一个都可以。

andyding · 发表于 2019-7-6 15:46

taoyi0727 发表于 2019-7-6 13:31
高手不屑搞
新手搞不定
这个主要有点耗时间尴尬了

确实有点

taoyi0727 · 发表于 2019-7-6 16:06

你这个就是要重新做面板要做动态的面板我就是个半桶水,不好弄

andyding · 发表于 2019-7-6 22:02

taoyi0727 发表于 2019-7-6 16:06
你这个就是要重新做面板要做动态的面板我就是个半桶水,不好弄

固定面板也可以, 刷属性少的块, 灰色一大片都没有关系

账号		自动登录	找回密码
密码			注册

[提问] 属性刷程序改进

最佳答案

评分