文本型点对表编辑
发个不成熟的函数，望高手们帮忙改进~~~~1.dcl控件不能对齐，不美观~
2.代码程序好像比较累赘，结构也不够合理~
函数：;文本型点对表编辑
;(editlst '(("标签1" . "值1") ("标签2" . "值2") ("标签3" . "值3") ("标签4" . "值4")))
(defun editlst (lst / getdata fname F1 I lst1 dclid)
(defun getdata()
(setq lst1 NIL I 1)
(foreach n lst
(setq LST1 (cons (cons (car n) (get_tile (strcat "KEY" (itoa I)))) LST1)
I (1+ I)
)
)
)
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq F1 (open fname "w"))
(write-line "EditDCL:dialog{label=\"文本型点对表编辑\";" F1)
(write-line ":boxed_column{ " F1)
(write-line ":row{\n:column{" F1)
(setq I 1)
(foreach n lst
(write-line
(strcat ":edit_box{label=\"" (car n)
"\";value=\"" (cdr n)
"\";key=\"KEY" (itoa I) "\";}"
)
F1
)
(if (= (rem i 10) 0) (write-line "}\n:column{" F1))
(setq I (1+ I))
)
(if (/= (rem (1- i) 10) 0) (write-line "}" F1))
(write-line "}\n}" F1)
(write-line "ok_cancel;" F1)
(write-line "}" F1)
(close F1)
(setq dclid (load_dialog fname))
(vl-file-delete fname)
(new_dialog "EditDCL" dclid)
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
(unload_dialog dclid)
(if lst1
(setq lst (reverse lst1))
(setq lst lst)
)
)用法示例：(defun c:xx-tt(/ ENT attlst)
(prompt "***属性块编辑****")
(while (setq ENT (CAR(entsel "\n 选择属性块:")))
(setq attlst(editlst (GetAttributes ent)))
(SetAttributes ent attlst)
(princ "继续选择下一属性块")
)
(princ)
);end defun ;|;;文本型点对表编辑
|
(editlst '(("标签1" . "值1")
("标签2" . "值2")
("标签3" . "值3")
("标签4" . "值4")
("标签5" . "值5")
("标签6" . "值6")
("标签7" . "值7")
("标签8" . "值8")
)
)
|;
(defun editlst (lst / getdata fname F1 I lst1 dclid)
(defun getdata ()
(setq lst1 NIL
I 1
)
(foreach n lst
(setq LST1 (cons (cons (car n) (get_tile (strcat "KEY" (itoa I))))
LST1
)
I (1+ I)
)
)
)
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq F1 (open fname "w"))
(write-line
"EditDCL:dialog{label=\"文本型点对表编辑 \";"
F1
)
(write-line ":boxed_column{ " F1)
(write-line ":row{\n:column{" F1)
(setq I 1)
(foreach n lst
(write-line
(strcat ":edit_box{label=\""
(car n)
"\";value=\""
(cdr n)
"\";key=\"KEY"
(itoa I)
"\";}"
)
F1
)
(if(= (rem i 5) 0)
(write-line "}\n:column{" F1)
)
(setq I (1+ I))
)
(if (/= (rem (1- i) 5) 0)
(write-line "}" F1)
)
(write-line "}\n}" F1)
(write-line "ok_cancel;" F1)
(write-line "}" F1)
(close F1)
(setq dclid (load_dialog fname))
(vl-file-delete fname)
(new_dialog "EditDCL" dclid)
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
(unload_dialog dclid)
(if lst1
(setq lst (reverse lst1))
(setq lst lst)
)
)
(defun c:xx-tt (/ ENT attlst)
(prompt "***属性块编辑****")
(while (setq ENT (CAR (entsel "\n 选择属性块:")))
(setq attlst (editlst (GetAttributes ent)))
(SetAttributes ent attlst)
(princ "继续选择下一属性块")
)
(princ)
)
怎么对齐？？？？？？
调整了一下，用edit_box。
(defun editlst (lst / dclfile dclfo i keys key dclid out)
(setq dclfile (vl-filename-mktemp nil nil ".dcl"))
(setq dclfo (open dclfile "w"))
(write-line "minbox:edit_box{fixed_width=true;fixed_height=true;vertical_margin=none;horizontal_margin=none;}" dclfo)
(write-line "consListEdit:dialog{label=\"文本型点对表编辑 \";" dclfo)
(write-line ":boxed_column{ " dclfo)
(setq i 1 keys nil)
(foreach n lst
(setq key (strcat "key" (itoa i)) keys (cons key keys))
(write-line ":row{" dclfo)
(write-line(strcat ":minbox{width=15;is_enabled=false;value=\""(car n)"\";}")dclfo)
(write-line(strcat ":minbox{width=20;value=\""(cdr n)"\";key=\"" key "\";}")dclfo)
(write-line "}" dclfo);row
(setq i (1+ i))
)
(setq keys(reverse keys))
(write-line "}" dclfo);boxed_column
(write-line "ok_cancel;" dclfo)
(write-line "}" dclfo);dialog
(close dclfo)
(setq dclid (load_dialog dclfile))
(vl-file-delete dclfile)
(new_dialog "consListEdit" dclid)
(mode_tile (car keys) 2)
(action_tile "accept" "(setq out(mapcar '(lambda(v k)(cons (car v)(get_tile k))) lst keys))(done_dialog)")
(action_tile "cancel" "(setq out nil)(done_dialog)")
(start_dialog)
(unload_dialog dclid)
out
)
(defun getAttributes (ent / lst)
(if (safearray-value (setq lst (vlax-variant-value (vla-getattributes (vlax-ename->vla-object ent)))))
(mapcar '(lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x)))
(vlax-safearray->list lst)
)
)
)
(defun setAttributes (ent lst / n atts)
(if (safearray-value (setq atts (vlax-variant-value (vla-getattributes (vlax-ename->vla-object ent)))))
(progn (foreach n lst
(mapcar '(lambda (x)
(if (= (strcase (car n)) (strcase (vla-get-tagstring x)))
(vla-put-textstring x (cdr n))
)
)
(vlax-safearray->list atts)
)
)
(vla-update (vlax-ename->vla-object ent))
)
)
) 无图无真相~~~
赞一个
坐等楼主完善了 非全部源码吧 尝试构件这样的DCL，
框架代码
:dialog {
:boxed_row {
:column {
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
:text {
label = "属性名" ;
}
}
:column {
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
:edit_box {
value = "属性值" ;
}
}
}
ok_cancel;
}
现将lst分解成两个表
(mapcar 'car lst)
(mapcar 'cdr lst)
计算新表字符串最大长度
(apply 'max (mapcar 'strlen lst1))
(apply 'max (mapcar 'strlen lst2))
分别赋值控件text和edit_box edit_box最好+上1~2个宽度值。
这样，DCL对齐，字符串在显示的时候完整。
77077 发表于 2015-9-15 11:02 static/image/common/back.gif
无图无真相~~~
给edit_box 一个宽度值不就可以了吗? edata 发表于 2015-9-15 20:52 static/image/common/back.gif
尝试构件这样的DCL，
E大讲的好深奥,学习了 先MARK，学习。 GetAttributesSetAttributes 没有 hbgsw 发表于 2015-9-16 13:49 static/image/common/back.gif
GetAttributesSetAttributes 没有
GetAttributesSetAttributes 论坛里面的通用函数~~~