已解决

rxbwyl

求各位版主、老师写个程序：文字转属性生成块，谢谢

程序要求：
图纸内容详见附件

王鹏_pBZlo

加载压缩包里的txtblk+b2x.fas后,
使用命令txtblk, 把文字转换成属性块TXTBLK
使用命令b2x, 通过选择一个属性块把所有同名属性块的属性值写入Excel文件 (注:需先打开Excel程序),接下来的工作就是Excel文件的修改了

renyonghua2014

论坛搜索就有的。

rxbwyl

renyonghua2014 发表于 2019-6-28 22:27
论坛搜索就有的。

已经把块相关的帖子都看了，没有找到啊

tzfcn

最好是做成一个插件，自动生成表格，并可以自由扩展。

pxr201419

试试这段程序能不能满足要求，只是不知道增加的一个属性是做什么用，这里写成了编号，做其它用则自己改一下。程序将数据保存为xls文件，开始时要求选择保存位置，程序结束后可以打开。格式不满意可以上传个范本来看一下再改。水平有限，见谅。
(defun c:tt()
        (if (= fil nil)        (setq fil (getfiled "文件保存位置" "" "xls" 33)))
          (setq fL (open fil "a"))
        (setq ss nil ss (ssadd) ee (ssget) bzst nil ii 0)
        (if (= (sslength ee) 4)(progn
        (while (< ii (SSLENGTH EE))
          (setq        wz (cdr (assoc 1 (entget (ssname ee ii)))) ii (1+ ii))
          (cond        ((vl-string-search "缆" wz) (setq bzst (cons "线长" bzst)))
                ((vl-string-search "地" wz) (setq bzst (cons "地长" bzst)))
                ((vl-string-search "GYTS" wz) (setq bzst (cons "规格" bzst)))
                ((vl-string-search "ZGG" wz) (setq bzst (cons "线序" bzst)))))
        (if (= (length bzst) 4)(progn
        (setq bzst (reverse bzst))
        (setq ii 0)
        (while (< ii (SSLENGTH EE))
                (setq bz (nth ii bzst))
                (setq wz (cdr (assoc 1 (entget (ssname ee ii)))))
                (write-Line (strcat bz "\t" wz) fl)
                  (setq tc (cdr (assoc 8 (entget (ssname ee ii)))))
                  (setq zb (cdr (assoc 10 (entget (ssname ee ii)))))
                  (setq st0 (vl-remove nil (mapcar '(lambda (x) (if (member (car x) (list -1 0 330 5 62)) nil x)) (entget (ssname ee ii)))))
                (setq ys (if (assoc 62 (entget (ssname ee ii))) (assoc 62 (entget (ssname ee ii))) (assoc 62 (tblsearch "layer" tc))))
                  (setq st1 (append '((0 . "ATTDEF")) (list ys) st0 (list(cons 3 wz))(list(cons 2 bz)) (list(cons 70 0))  ))
                (entmake st1)
                (ssadd (entlast) ss)(setq ii (1+ ii))
          )
        (setq i 0)
        (while (ssname ee i)(entdel (SSNAME ee i))(setq i (1+ i)))
        (setq i 1)
        (while (tblsearch "block" (strcat "g00" (rtos i)) (setq i (1+ i))))
        (setq km (strcat "g00" (rtos (1- i))))
        (vl-cmdf "block" km (list (car zb)(cadr zb)) ss "")
        (VL-CMDF "insert" km (list (car zb)(cadr zb)) "" "" "")
        (setq pt (getpoint "\n选择放置编号的位置:"))
          (setq st2 (vl-remove nil (mapcar '(lambda (x) (if (member (car x) (list 1 2 3 11 10 71 72 73)) nil x)) st1)))
          (setq st2 (append st2 (list(cons 10 pt))(list(cons 1 "编号"))(list (cons 2 (strcase km)))(list(cons 3 "编号")) ))
        (entmake st2)))))
        (close fl)
)

pxr201419

第3行改一下
(setq ss nil ss (ssadd) ee (ssget '((0 . "TEXT"))) bzst nil ii 0)

rxbwyl

pxr201419 发表于 2019-6-29 21:46
试试这段程序能不能满足要求，只是不知道增加的一个属性是做什么用，这里写成了编号，做其它用则自己改一下 ...

老师，新增一个5.属性   是方便修改上面的4行数据是  新建 拆除的，在win7 64和CAD2014 64 的环境运行，只是把TEXT文字提取到表格，图纸中的文字删除了，后面属性块没有生成，

希望  生成的属性块还是在原文本的位置上  

另外可以加些选择么

有时候选择的文本可能只有地长 规格 属性  这3个值的

提取的数据能按表格里的顺序排列么？

rxbwyl

pxr201419 发表于 2019-6-29 21:46
试试这段程序能不能满足要求，只是不知道增加的一个属性是做什么用，这里写成了编号，做其它用则自己改一下 ...

命令: TT

选择对象: 找到 1 个

选择对象: 找到 1 个，总计 2 个

选择对象: 找到 1 个，总计 3 个

选择对象: 找到 1 个，总计 4 个

选择对象:
nil

命令:
命令:
命令: 指定对角点或 [栏选(F)/圈围(WP)/圈交(CP)]: *取消*

命令: *取消*

命令:
命令:
命令:
命令: _ddedit
选择注释对象或 [放弃(U)]:
选择注释对象或 [放弃(U)]:
选择注释对象或 [放弃(U)]:
选择注释对象或 [放弃(U)]:

命令: TT

选择对象: 找到 1 个

选择对象: 找到 1 个，总计 2 个

选择对象: 找到 1 个，总计 3 个

选择对象: 找到 1 个，总计 4 个

选择对象:

选择放置编号的位置:nil



程序到这里就结束了  老师

王鹏_pBZlo

1）判断是否存在块###，若不存在创建属性块###,该属性块有5个属性，属性名分别为？？？，属性提示分别为？？？
2) 每次选择最多4个文字，替换成属性块###，文字需要保留在原先的位置
3)具有文字特点？？？的文字对应的属性是？？？
把上述的要求重新编辑下，我来试试
关于表格，可以通过属性块来获得，因为属性块里已经包含有所有数据，用另外的插件来处理
来自: 微社区

rxbwyl

王鹏_pBZlo 发表于 2019-6-30 11:24
1）判断是否存在块###，若不存在创建属性块###,该属性块有5个属性，属性名分别为？？？，属性提示分别为？ ...

老师，附件和要求重新编辑了

rxbwyl

王鹏_pBZlo 发表于 2019-6-30 17:31
加载压缩包里的txtblk+b2x.fas后,
使用命令txtblk, 把文字转换成属性块TXTBLK
使用命令b2x, 通过选择一个 ...

                               
登录/注册后可看大图

老师帮忙修改一下

王鹏_pBZlo

... ... ... ... ...
来自: 微社区

王鹏_pBZlo

... ... ... ... ... ...
来自: 微社区

王鹏_pBZlo

rxbwyl 发表于 2019-6-30 18:10
老师帮忙修改一下

属性定义名称已修改成中文