设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 文本型点对表编辑
123下一页
返回列表 发新帖
查看: 6216|回复: 20

[函数] 文本型点对表编辑

[复制链接]
77077
发表于 2015-9-15 10:56:23 | 显示全部楼层 |阅读模式
发个不成熟的函数，望高手们帮忙改进~~~~
1.dcl控件不能对齐，不美观~
2.代码程序好像比较累赘，结构也不够合理~
函数：
  2. ;文本型点对表编辑
  3. ;(editlst '(("标签1" . "值1") ("标签2" . "值2") ("标签3" . "值3") ("标签4" . "值4")))
  4. (defun editlst (lst / getdata fname F1 I lst1 dclid)  
  5.   (defun getdata()
  6.      (setq lst1 NIL I 1)
  7.       (foreach n lst
  8.         (setq LST1 (cons (cons (car n) (get_tile (strcat "KEY" (itoa I)))) LST1)
  9.              I (1+ I)
  10.             )
  11.       )
  12.   )
  13.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
  14.   (setq F1 (open fname "w"))
  15.   (write-line "EditDCL:dialog{label="文本型点对表编辑";" F1)
  16.   (write-line ":boxed_column{ " F1)
  17.   (write-line ":row{\n:column{" F1)
  18.   (setq I 1)
  19.   (foreach n lst
  20.    (write-line
  21.     (strcat ":edit_box{label="" (car n)
  22.                    "";value="" (cdr n)
  23.                    "";key="KEY" (itoa I) "";}"
  24.            )
  25.      F1
  26.    )
  27.    (if (= (rem i 10) 0) (write-line "}\n:column{" F1))
  28.    (setq I (1+ I))
  29.   )
  30. (if (/= (rem (1- i) 10) 0) (write-line "}" F1))
  31.   (write-line "}\n}" F1)
  32.   (write-line "ok_cancel;" F1)
  33.   (write-line "}" F1)
  34.   (close F1)
  35.   (setq dclid (load_dialog fname))
  36.   (vl-file-delete fname)
  37.   (new_dialog "EditDCL" dclid)
  38.   (action_tile "accept" "(getdata)(done_dialog 1)")
  39.   (action_tile "cancel" "(done_dialog 0)")
  40.   (start_dialog)
  41.   (unload_dialog dclid)
  42.   (if lst1
  43.     (setq lst (reverse lst1))
  44.     (setq lst lst)
  45.     )
  46. )
用法示例：
  2. (defun c:xx-tt(/ ENT attlst)
  3.    (prompt "***属性块编辑****")
  4.    (while (setq ENT (CAR(entsel "\n 选择属性块:")))
  5.      (setq attlst(editlst (GetAttributes ent)))
  6.      (SetAttributes ent attlst)
  7.      (princ "继续选择下一属性块")
  8.    )
  9.   (princ)
  10. );end defun
标签, 程序

点评

myjping
最简单的办法，分种两列  发表于 2015-9-15 22:15
lucas_3333
为什么还要写代码做这个? CAD自带命令attedit 不可以吗?  发表于 2015-9-15 18:51

评分

参与人数 3明经币 +1 金钱 +10 收起 理由
zhangcan0515 + 5
biya + 5 赞一个!
zctao1966 + 1 很给力!

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下

相关帖子
回复

使用道具 举报

qyming
发表于 2018-1-4 13:10:18 | 显示全部楼层
  1. ;|;;文本型点对表编辑
  2. |
  3. (editlst '(("标签1" . "值1")
  4.      ("标签2" . "值2")
  5.      ("标签3" . "值3")
  6.      ("标签4" . "值4")
  7.      ("标签5" . "值5")
  8.      ("标签6" . "值6")
  9.      ("标签7" . "值7")
  10.      ("标签8" . "值8")
  11.     )
  12. )
  13. |;
  14. (defun editlst (lst / getdata fname F1 I lst1 dclid)
  15.   (defun getdata ()
  16.     (setq lst1 NIL
  17.     I    1
  18.     )
  19.     (foreach n lst
  20.       (setq LST1 (cons (cons (car n) (get_tile (strcat "KEY" (itoa I))))
  21.            LST1
  22.      )
  23.       I   (1+ I)
  24.       )
  25.     )
  26.   )
  27.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
  28.   (setq F1 (open fname "w"))
  29.   (write-line
  30.     "EditDCL:dialog{label=\"文本型点对表编辑 \";"
  31.     F1
  32.   )
  33.   (write-line ":boxed_column{ " F1)
  34.   (write-line ":row{\n:column{" F1)
  35.   (setq I 1)
  36.   (foreach n lst
  37.     (write-line
  38.       (strcat ":edit_box{label=\""
  39.         (car n)
  40.         "\";value=\""
  41.         (cdr n)
  42.         "\";key=\"KEY"
  43.         (itoa I)
  44.         "\";}"
  45.       )
  46.       F1
  47.     )
  48.     (if  (= (rem i 5) 0)
  49.       (write-line "}\n:column{" F1)
  50.     )
  51.     (setq I (1+ I))
  52.   )
  53.   (if (/= (rem (1- i) 5) 0)
  54.     (write-line "}" F1)
  55.   )
  56.   (write-line "}\n}" F1)
  57.   (write-line "ok_cancel;" F1)
  58.   (write-line "}" F1)
  59.   (close F1)
  60.   (setq dclid (load_dialog fname))
  61.   (vl-file-delete fname)
  62.   (new_dialog "EditDCL" dclid)
  63.   (action_tile "accept" "(getdata)(done_dialog 1)")
  64.   (action_tile "cancel" "(done_dialog 0)")
  65.   (start_dialog)
  66.   (unload_dialog dclid)
  67.   (if lst1
  68.     (setq lst (reverse lst1))
  69.     (setq lst lst)
  70.   )
  71. )
  72. (defun c:xx-tt (/ ENT attlst)
  73.   (prompt "***属性块编辑****")
  74.   (while (setq ENT (CAR (entsel "\n 选择属性块:")))
  75.     (setq attlst (editlst (GetAttributes ent)))
  76.     (SetAttributes ent attlst)
  77.     (princ "继续选择下一属性块")
  78.   )
  79.   (princ)
  80. )


怎么对齐？？？？？？

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

77077
 楼主| 发表于 2021-2-20 21:37:51 | 显示全部楼层
调整了一下，用edit_box。

  3. (defun editlst (lst / dclfile dclfo i keys key dclid out)
  4.         (setq dclfile (vl-filename-mktemp nil nil ".dcl"))
  5.         (setq dclfo (open dclfile "w"))
  6.         (write-line "minbox:edit_box{fixed_width=true;fixed_height=true;vertical_margin=none;horizontal_margin=none;}" dclfo)
  7.         (write-line "consListEdit:dialog{label="文本型点对表编辑 ";" dclfo)
  8.         (write-line ":boxed_column{ " dclfo)
  9.         (setq i 1 keys nil)
  10.         (foreach n lst
  11.                 (setq key (strcat "key" (itoa i)) keys (cons key keys))
  12.                 (write-line ":row{" dclfo)
  13.                 (write-line(strcat ":minbox{width=15;is_enabled=false;value=""(car n)"";}")dclfo)
  14.                 (write-line(strcat ":minbox{width=20;value=""(cdr n)"";key="" key "";}")dclfo)
  15.                 (write-line "}" dclfo);row
  16.                 (setq i (1+ i))
  17.         )
  18.         (setq keys(reverse keys))
  19.         (write-line "}" dclfo);boxed_column
  20.         (write-line "ok_cancel;" dclfo)
  21.         (write-line "}" dclfo);dialog
  22.         (close dclfo)
  23.         (setq dclid (load_dialog dclfile))
  24.         (vl-file-delete dclfile)
  25.         (new_dialog "consListEdit" dclid)
  26.         (mode_tile (car keys) 2)
  27.         (action_tile "accept" "(setq out(mapcar '(lambda(v k)(cons (car v)(get_tile k))) lst keys))(done_dialog)")
  28.         (action_tile "cancel" "(setq out nil)(done_dialog)")
  29.         (start_dialog)
  30.         (unload_dialog dclid)
  31.         out
  32. )
回复 支持 反对

使用道具 举报

qyming
发表于 2018-1-4 13:11:28 | 显示全部楼层
  1. (defun getAttributes        (ent / lst)
  2.   (if (safearray-value (setq lst (vlax-variant-value (vla-getattributes (vlax-ename->vla-object ent)))))
  3.     (mapcar '(lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x)))
  4.             (vlax-safearray->list lst)
  5.     )
  6.   )
  7. )

  9. (defun setAttributes        (ent lst / n atts)
  10.   (if (safearray-value (setq atts (vlax-variant-value (vla-getattributes (vlax-ename->vla-object ent)))))
  11.     (progn (foreach n lst
  12.              (mapcar '(lambda (x)
  13.                         (if (= (strcase (car n)) (strcase (vla-get-tagstring x)))
  14.                           (vla-put-textstring x (cdr n))
  15.                         )
  16.                       )
  17.                      (vlax-safearray->list atts)
  18.              )
  19.            )
  20.            (vla-update (vlax-ename->vla-object ent))
  21.     )
  22.   )
  23. )
回复 支持 反对

使用道具 举报

77077
 楼主| 发表于 2015-9-15 11:02:50 | 显示全部楼层
无图无真相~~~

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

伪书虫86
发表于 2015-9-15 13:00:45 | 显示全部楼层
赞一个
坐等楼主完善了

点评

lucas_3333
完善啥? 楼主探讨的应该是方法, 如果实用就用attedit  发表于 2015-9-16 08:51
回复 支持 反对

使用道具 举报

zzyong00
发表于 2015-9-15 14:11:06 | 显示全部楼层
非全部源码吧
回复 支持 反对

使用道具 举报

edata
发表于 2015-9-15 20:52:19 | 显示全部楼层
尝试构件这样的DCL，


框架代码
  1. :dialog {
  2.     :boxed_row {
  3.         :column {
  4.             :text {
  5.                 label = "属性名" ;
  6.             }
  7.             :text {
  8.                 label = "属性名" ;
  9.             }
  10.             :text {
  11.                 label = "属性名" ;
  12.             }
  13.             :text {
  14.                 label = "属性名" ;
  15.             }
  16.             :text {
  17.                 label = "属性名" ;
  18.             }
  19.             :text {
  20.                 label = "属性名" ;
  21.             }
  22.             :text {
  23.                 label = "属性名" ;
  24.             }
  25.             :text {
  26.                 label = "属性名" ;
  27.             }
  28.             :text {
  29.                 label = "属性名" ;
  30.             }
  31.             :text {
  32.                 label = "属性名" ;
  33.             }
  34.         }
  35.         :column {
  36.             :edit_box {
  37.                 value = "属性值" ;
  38.             }
  39.             :edit_box {
  40.                 value = "属性值" ;
  41.             }
  42.             :edit_box {
  43.                 value = "属性值" ;
  44.             }
  45.             :edit_box {
  46.                 value = "属性值" ;
  47.             }
  48.             :edit_box {
  49.                 value = "属性值" ;
  50.             }
  51.             :edit_box {
  52.                 value = "属性值" ;
  53.             }
  54.             :edit_box {
  55.                 value = "属性值" ;
  56.             }
  57.             :edit_box {
  58.                 value = "属性值" ;
  59.             }
  60.             :edit_box {
  61.                 value = "属性值" ;
  62.             }
  63.             :edit_box {
  64.                 value = "属性值" ;
  65.             }
  66.         }
  67.     }
  68.     ok_cancel;
  69. }

现将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对齐，字符串在显示的时候完整。


本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

lucas_3333
发表于 2015-9-16 08:48:39 | 显示全部楼层
77077 发表于 2015-9-15 11:02
无图无真相~~~

给edit_box 一个宽度值不就可以了吗?
回复 支持 反对

使用道具 举报

lucas_3333
发表于 2015-9-16 08:53:28 | 显示全部楼层
edata 发表于 2015-9-15 20:52
尝试构件这样的DCL，

E大讲的好深奥,  学习了
回复 支持 反对

使用道具 举报

hbgsw
发表于 2015-9-16 09:59:31 | 显示全部楼层
先MARK，学习。
回复 支持 反对

使用道具 举报

hbgsw
发表于 2015-9-16 13:49:34 | 显示全部楼层
GetAttributes  SetAttributes 没有

点评

lucas_3333
这个通用函数,搜搜就有了, 爱劳动才有果子吃,[em14]  发表于 2015-9-16 14:10
回复 支持 反对

使用道具 举报

77077
 楼主| 发表于 2015-9-16 22:29:10 | 显示全部楼层
hbgsw 发表于 2015-9-16 13:49
GetAttributes  SetAttributes 没有

GetAttributes  SetAttributes 论坛里面的通用函数~~~
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-23 12:30 , Processed in 0.239155 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表