如何批量提取图纸中的文字

一只傲娇喵

下面1所示


每个图的右下角是想提取的一些文字，比如文件编码（图2）

但是文件编码是在块里面，后面的编码是文字，
最后要实现的效果大概就是文件夹选中，然后得到文件夹里面所有图纸的文件编码

希望大佬给个思路，不限语言

vitalgg

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
2. (setq txt-flag "文件编码")
   
3. (setq length-times 6);;序号长度相对标志文字长度的倍数
   
4. (defun get-serial-by-flag(flag ents-txt / box4pt box)
   
5.   (if (and ents-txt
   
6.      flag)
   
7.       (progn
   
8.   (setq box4pt (text:box flag))
   
9.   (setq txt-serails
   
10.         (list:sort
    
11.          (vl-remove-if-not
    
12.     '(lambda(x / box1)
    
13.        (if (setq box1 (entity:getbox x 0))
    
14.            (inters
    
15.       (setq pt-s (point:mid (nth 1 box4pt)(nth 2 box4pt)))
    
16.       (polar pt-s
    
17.              (angle (nth 0 box4pt)(nth 1 box4pt))
    
18.              (* length-times (distance (nth 0 box4pt)(nth 1 box4pt))))
    
19.       (car box1)
    
20.       (cadr box1))))
    
21.     ents-txt
    
22.     )
    
23.          '(lambda(x y / *error*)
    
24.       (if (and x y)
    
25.           (< (distance (entity:getdxf x 10)(entity:getdxf flag 10))
    
26.        (distance (entity:getdxf y 10)(entity:getdxf flag 10))))))
    
27.         )
    
28.   (car (string:auto-split
    
29.         (string:from-list
    
30.          (mapcar '(lambda(x)
    
31.         (entity:getdxf x 1))
    
32.            txt-serails)
    
33.          ""))))))
    
34. (defun get-serial-in-blk (blkname / flags ss-in-blk ss-in-blks)
    
35.   (setq ss-in-blk (block:ent-list blkname))
    
36.   (setq txt-in-blk (pickset:get-sub
    
37.      ss-in-blk
    
38.      '((0 . "text"))))
    
39.   (mapcar 'get-serial-by-flag
    
40.     (setq flags (pickset:get-sub ss-in-blk (list (cons 1 txt-flag))))
    
41.     (mapcar '(lambda(x)
    
42.          txt-in-blk)
    
43.       flags))
    
44.   )
    
45. (defun get-serial-in-space (/ ss-flags )
    
46.   (setq ss-flags (pickset:to-list (ssget "x" (list (cons 1 txt-flag)))))
    
47.   ;; 模型或布局空间
    
48.   (mapcar 'get-serial-by-flag
    
49.      ss-flags
    
50.      (mapcar
    
51.       '(lambda(x)
    
52.          (pickset:to-list (ssget "x" (list '(0 . "text")
    
53.              (cons 410 (entity:getdxf
    
54.                   x
    
55.                   410))))))
    
56.       ss-flags
    
57.       )))
    
58. (defun get-serial (/  ss-flags)
    
59.   "选择标志文字后面的英文字符"
    
60.   (setq res-in-space (get-serial-in-space))
    
61.   ;; 块内
    
62.   (setq res-in-blk
    
63.   (mapcar 'get-serial-in-blk (block:list)))
    
64.   (append res-in-space (apply 'append res-in-blk))
    
65.   )

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> (setq txt-flag "文件编码")<br /> (setq length-times 6);;序号长度相对标志文字长度的倍数<br /> (defun get-serial-by-flag(flag ents-txt / box4pt box)<br />   (if (and ents-txt<br />      flag)<br />       (progn<br />   (setq box4pt (text:box flag))<br />   (setq txt-serails<br />         (list:sort<br />          (vl-remove-if-not<br />     '(lambda(x / box1)<br />        (if (setq box1 (entity:getbox x 0))<br />            (inters<br />       (setq pt-s (point:mid (nth 1 box4pt)(nth 2 box4pt)))<br />       (polar pt-s<br />              (angle (nth 0 box4pt)(nth 1 box4pt))<br />              (* length-times (distance (nth 0 box4pt)(nth 1 box4pt))))<br />       (car box1)<br />       (cadr box1))))<br />     ents-txt<br />     )<br />          '(lambda(x y / *error*)<br />       (if (and x y)<br />           (< (distance (entity:getdxf x 10)(entity:getdxf flag 10))<br />        (distance (entity:getdxf y 10)(entity:getdxf flag 10))))))<br />         )<br />   (car (string:auto-split<br />         (string:from-list<br />          (mapcar '(lambda(x)<br />         (entity:getdxf x 1))<br />            txt-serails)<br />          ""))))))<br /> (defun get-serial-in-blk (blkname / flags ss-in-blk ss-in-blks)<br />   (setq ss-in-blk (block:ent-list blkname))<br />   (setq txt-in-blk (pickset:get-sub<br />      ss-in-blk<br />      '((0 . "text"))))<br />   (mapcar 'get-serial-by-flag<br />     (setq flags (pickset:get-sub ss-in-blk (list (cons 1 txt-flag))))<br />     (mapcar '(lambda(x)<br />          txt-in-blk)<br />       flags))<br />   )<br /> (defun get-serial-in-space (/ ss-flags )<br />   (setq ss-flags (pickset:to-list (ssget "x" (list (cons 1 txt-flag)))))<br />   ;; 模型或布局空间<br />   (mapcar 'get-serial-by-flag<br />      ss-flags<br />      (mapcar<br />       '(lambda(x)<br />          (pickset:to-list (ssget "x" (list '(0 . "text")<br />              (cons 410 (entity:getdxf<br />                   x<br />                   410))))))<br />       ss-flags<br />       )))<br /> (defun get-serial (/  ss-flags)<br />   "选择标志文字后面的英文字符"<br />   (setq res-in-space (get-serial-in-space))<br />   ;; 块内<br />   (setq res-in-blk<br />   (mapcar 'get-serial-in-blk (block:list))) <br />   (append res-in-space (apply 'append res-in-blk))<br />   )

烟盒迷唇

坐标啊，某个位置的坐标，然后获取文字

一只傲娇喵

烟盒迷唇 发表于 2024-1-29 19:12
坐标啊，某个位置的坐标，然后获取文字

坐标好像也不太好得到

弥勒

;创建图层
(defun LL(str)
              (command "layer" "m" str "")
)

;取组码中的文字
(defun V#  (n e / pt_)
(if (not (listp e)) (setq e (entget e)))
(setq pt_ (cdr (assoc n e)))
(if (and (> n 9) (< n 34) (/= pt_ nil) ) (trans pt_ 0 1) (setq pt_ pt_) )
)

guosheyang

表 是 table 还是 线画表   所有图的表 是否是一样大小的？

自贡黄明儒

标题栏一般是属性块，只要知道块名，沿块搜索，就可以找到需要的属性。

一只傲娇喵

guosheyang 发表于 2024-1-29 22:34
表 是 table 还是 线画表   所有图的表 是否是一样大小的？

表和最外层的图框一起是个块，但是需要的文字不是块属性里的，大小不一样

一只傲娇喵

vitalgg 发表于 2024-1-29 23:24

大佬太强哩，还没看懂，待我试试行不行

vitalgg

只支持单行文本。如果是其它的如多行文本，属性，天正文本等，需的修改选择过程。