批量选择文字到表格

gduthy

(defun C:TWZ (/ n ss &kw L ff %k %k1 %k2 %k3 %k4 %k5 %k6)
                                        ;批量选择文字到表格
  (setvar "cmdecho" 0)
  ;;关闭变量
  (setvar "blipmode" 0)
  ;;关闭控制点
  (vl-load-com)
  ;;加载vlax扩展函数
  (setq        n  0
        ss '()
  )
  ;;取得一个空表
  (princ "\n请选择文字")
  (setq &kw (ssget '((0 . "TEXT,MTEXT") (1 . "*"))))
                                        ;选择文字，文字内容有字母K
  (if (/= &kw nil)
    ;;如果有选择了文字
    (progn
      (setq L  (sslength &kw)
            ff (open "d://文字到表格.xls" "w")
                                        ;建立文本;W会把文本里面的内容清除
      )
      ;;建立的文本在D盘就可以看到
      (repeat L
        (setq &kw1 (entget (ssname &kw n))
              %k1  (cdr (assoc 10 &kw1))
              ;;取得文字坐标
              %k2  (cdr (assoc 1 &kw1))
              ;;取得文字内容
              ss   (cons (list %k1 %k2) ss)
              ;;加入选择集
              n           (+ n 1)
        )
      )
    )
  )

    (princ %k2 )
)

vip-happy

还以为可以赶个懒，不行，还是自己动手
留给需要的人

;;;====== 批量选择文字到表格 ======
(Defun C:GETTXTTOXLS ( / ad ent et fn i p1 p2 ss)
(Setq Ent (Entget (Car (Entsel "\n点取近似文字。。")))
            Ad (List (Assoc 0 Ent) (Assoc 8 Ent) (Assoc 7 Ent))
            Fn (Open (Getfiled "保存为:" "" "Xls" 1) "W")
)
(While (And (Setq P1 (Getpoint  "\n指定一角点："))
            (Setq P2 (Getcorner P1 "\n指定对角点："))
)
(Setq Ss (Ssget "C" P1 P2 Ad)
I (Sslength Ss))
(Repeat I
        (Setq I (1- I)
                Et (Cdr (Assoc 1 (Entget (Ssname Ss I))))
        )
(Princ "\n" Fn)(Princ Et Fn)
))(Close Fn)
  (Princ)
)
(Prompt "\n提文字到电子表格，键入 GETTXTTOXLS 启动程序")

LIULISHENG

我来顶楼主一下

664571221

你好怎么使用的好像不能用啊

sunny_8848

看不出效果

熊咔咔

vip-happy 发表于 2020-12-8 17:39
还以为可以赶个懒，不行，还是自己动手
留给需要的人

大佬，您这代码，我为啥运行的时候，提示n点取近似文字之后，显示参数类型错误：lentityp nil

熊咔咔

打开xls的话，会显示文件被另一个用户使用，点只读后，会显示文件扩展名不符，无视的话，打开是空白的

paulpipi

vip-happy

熊咔咔 发表于 2020-12-10 11:21
大佬，您这代码，我为啥运行的时候，提示n点取近似文字之后，显示参数类型错误：lentityp nil

不是什么大佬，点取近似文字，是取得该字的图层和文字样式，将“\N”为“\n”，一个大写的错误，Win10+CAD2014+Tch2014是测试通过的，用它提取了一套图纸的房间名，不应该发生参数类型错误，代码未运行完才会出现xls被另一个用户使用