块内图元的坐标定位[已解决]感谢版主

CAD新军

我想弄一个搜索指定文字，然后引线的脚本。块内图元定位总是不正确，求高手指导一下。我发现了，无论块怎么移动、复制，定位都是按块最初插入的位置来的。源码附。

因为注释写得不多，而且是从自己写的一个图层控制里面拷过来的通用函数，简单说一下几个函数的用途

1. C:TT
   
2. HLJ:DXF
   
3. HLJ:BLKQ
   
4. HLJ:ITERSS
   
5. HLJ:SS2SETS

复制代码

TT是调用函数

DXF ( id item ) 取得图元指定项属性的，如这里核心是 (DXF 10 k) 取得图元坐标
SS2SETS( ss )  把TT函数里面的ssget选定的所有图元生成一张图元表，然后扔给迭代函数ITERSS
ITERSS(set) 接力SS2SETS，按需要改写，把图元表里面的所有图元遍历，按需要选中一批生成另外一张表，如果遇到块，会送到BLKQ()迭代块里面的元素
BLKQ() 当ITERSS遇到块时，送进这里处理，返回块里的所有元素，再进行一次ITERSS

xyp1964

1. (defun c:tt ()
   
2.   (princ "\n请选择范围")
   
3.   (if (setq ss (ssget '((0 . "text,insert"))))
   
4.     (mapcar '(lambda (x)
   
5.                (cond ((= (hlj-dxf 0 x) "TEXT")
   
6.                       (command "LINE" (hlj-dxf 10 x) '(0 0) "")
   
7.                      )
   
8.                      ((= (hlj-dxf 0 x) "INSERT")
   
9.                       (setq p0 (hlj-dxf 10 x)
   
10.                             aa (vl-remove-if
    
11.                                  '(lambda (y) (/= (hlj-dxf 0 y) "TEXT"))
    
12.                                  (hlj-blkQ (hlj-dxf 2 x))
    
13.                                )
    
14.                       )
    
15.                       (foreach a aa
    
16.                         (setq p1 (hlj-dxf 10 a)
    
17.                               p1 (mapcar '(lambda (x y) (+ y x)) p1 p0)
    
18.                         )
    
19.                         (command "LINE" p1 '(0 0) "")
    
20.                       )
    
21.                      )
    
22.                )
    
23.              )
    
24.             (ss2list ss)
    
25.     )
    
26.   )
    
27.   (princ)
    
28. )
    
29. 
    
30. ;; 次级函数
    
31. (defun hlj-dxf (n s1) (cdr (assoc n (entget s1))))
    
32. 
    
33. ;; 枚举块中的图元 (hlj-blkQ (hlj-dxf 2 (entget blkname)))
    
34. ;; (setq blkname (car (entsel "\n选择: ")))
    
35. (defun hlj-blkQ        (blkname / a lst)
    
36.   (setq        a   (cdr (assoc -2 (tblsearch "BLOCK" blkname)))
    
37.         lst (cons a lst)
    
38.   )
    
39.   (while (setq a (entnext a))
    
40.     (setq lst (cons a lst))
    
41.   )
    
42.   lst
    
43. )
    
44. 
    
45. ;; 下面部分ssget选择集初始化成图元表
    
46. (defun ss2list (ss / sets itemlist i ent ent)
    
47.   (setq        sets (list)
    
48.         n    (sslength ss)
    
49.   )
    
50.   (setq i (- n 1))
    
51.   (repeat n
    
52.     (setq ent  (ssname ss i)
    
53.           sets (cons ent sets)
    
54.           i    (1- i)
    
55.     )
    
56.   )
    
57.   sets
    
58. )

(defun c:tt ()<br />   (princ "\n请选择范围")<br />   (if (setq ss (ssget '((0 . "text,insert"))))<br />     (mapcar '(lambda (x)<br />                (cond ((= (hlj-dxf 0 x) "TEXT")<br />                       (command "LINE" (hlj-dxf 10 x) '(0 0) "")<br />                      )<br />                      ((= (hlj-dxf 0 x) "INSERT")<br />                       (setq p0 (hlj-dxf 10 x)<br />                             aa (vl-remove-if<br />                                  '(lambda (y) (/= (hlj-dxf 0 y) "TEXT"))<br />                                  (hlj-blkQ (hlj-dxf 2 x))<br />                                )<br />                       )<br />                       (foreach a aa<br />                         (setq p1 (hlj-dxf 10 a)<br />                               p1 (mapcar '(lambda (x y) (+ y x)) p1 p0)<br />                         )<br />                         (command "LINE" p1 '(0 0) "")<br />                       )<br />                      )<br />                )<br />              )<br />             (ss2list ss)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;; 次级函数<br /> (defun hlj-dxf (n s1) (cdr (assoc n (entget s1))))<br /> <br /> ;; 枚举块中的图元 (hlj-blkQ (hlj-dxf 2 (entget blkname)))<br /> ;; (setq blkname (car (entsel "\n选择: ")))<br /> (defun hlj-blkQ        (blkname / a lst)<br />   (setq        a   (cdr (assoc -2 (tblsearch "BLOCK" blkname)))<br />         lst (cons a lst)<br />   )<br />   (while (setq a (entnext a))<br />     (setq lst (cons a lst))<br />   )<br />   lst<br /> )<br /> <br /> ;; 下面部分ssget选择集初始化成图元表<br /> (defun ss2list (ss / sets itemlist i ent ent)<br />   (setq        sets (list)<br />         n    (sslength ss)<br />   )<br />   (setq i (- n 1))<br />   (repeat n<br />     (setq ent  (ssname ss i)<br />           sets (cons ent sets)<br />           i    (1- i)<br />     )<br />   )<br />   sets<br /> )

CAD新军

哦，对了，代码只会对单行文字引线，测试就是弄一个文字，然后做成快，TT，选中块和不是块内的文字观察区别

start4444

画线的时候把捕捉关了没

CAD新军

start4444 发表于 2019-3-24 15:09
画线的时候把捕捉关了没

关了也没变化。而且你可以看到，非块内图元线是正确的，就是从文字图元坐标至原点

start4444

你发的代码对块无反应

CAD新军

xyp1964 发表于 2019-3-24 18:58

感谢大神，完全能用！我学习一下怎么实现的

烟盒迷唇

学学看看如何制作