点选实体获取轴号，麻烦各位大师帮忙优化完善，谢谢！

tender138

原贴：请问各位大师如何获取与实体相交的轴号？重复麻烦版主删除，谢谢 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz!特别鸣谢你有种再说一遍

东拼西凑搞了个《点选实体获取轴号》，其中引用了之前收集的各位大师函数，具体贵号忘记了，在此一并致谢！！！
现在我是按附件“Drawing1.dwg”测试的，基本能实现要求，但是不通用，设定的特定条件为：
1、轴线在“AXIS”图层，轴号在“AXIS_NUM”图层（通用应该提示选图层）
2、轴线为直线（通用应该各种类型线均可）
3、轴线已经与轴号相交了（通用应该绘制构造线或射线延伸相交？）
4、轴网、轴号已经打散（原图为块）
现在希望各位大师能帮忙优化完善使之能在附件“Drawing2.dwg”中测试通过，在此先致谢！

飞雪神光

我的思路是
计算实体包围框
然后选择原图的块 undo m标记
分解块 获取分解后的选择集
筛选属性轴号  
遍历轴号的X值与Y值 与实体包围框的 X范围与Y范围进行比对  
不需要轴线的参与 也没有屏幕外ssget失灵的问题
完成后  undo b 还原块

因为用到了 nentsel 所以 "选择图块及轴号图层"是要点击块内轴号的文字 也可以改成分开获取图块图元和轴号图层

1. (defun c:tt (/ *error* clst getattvalue get-dxf getsolidbox isattrclock nent pt ptlst ss ss-enlst tkty ys yx zhkm zhtc zhx zhy zs zx)
   
2.   (defun *error* (s)
   
3.     (setq acadver (atof (getvar "acadver")))
   
4.     (if (> acadver 19.1)
   
5.       (command-s "undo" "b")
   
6.     )
   
7.     (if (<= acadver 19.1)
   
8.       (command "undo" "b")
   
9.     )
   
10.   )
    
11.   (defun GetSolidBox(ent / LB_pt RT_pt RB_pt LT_pt lst)
    
12.     (if ent
    
13.       (progn
    
14.         (if (= (type ent) 'LIST) (setq ent (car ent)))
    
15.         (setq ent (vlax-ename->vla-object ent))
    
16.         (vla-GetBoundingBox ent 'minpoint 'maxpoint)
    
17.         (setq LB_pt (vlax-safearray->list minpoint))
    
18.         (setq RT_pt (vlax-safearray->list maxpoint))
    
19.         (setq RB_pt (list (car RT_pt) (cadr LB_pt)))
    
20.         (setq LT_pt (list (car LB_pt) (cadr RT_pt)))
    
21.         (setq lst (list LB_pt RB_pt RT_pt LT_pt))
    
22.       )
    
23.     )
    
24.     lst
    
25.   )
    
26.   (defun ss-enlst (ss / enlst)
    
27.     (cond
    
28.       ((= (type ss) 'PICKSET)
    
29.         (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
    
30.       )
    
31.       ((= (type ss) 'LIST)
    
32.         (setq enlst (ssadd))
    
33.         (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    
34.       )
    
35.     )
    
36.   )
    
37.   (defun get-dxf(en n)
    
38.     (if (not (listp en)) (setq en (entget en)))
    
39.     (cdr (assoc n en))
    
40.   )
    
41.   
    
42.   (defun isAttrClock(ClockName / isTrue)
    
43.     (if (= (type ClockName) 'LIST) (setq ClockName (car ClockName)))
    
44.     (setq is (vlax-get-property (vlax-ename->vla-object ClockName) "HasAttributes"))
    
45.     (if (= is :vlax-true)
    
46.       T
    
47.       nil
    
48.     )
    
49.   )
    
50.   (defun GetAttValue (en FenGe / i dxf EntName AttValu str)
    
51.     (if (= (type en) 'LIST) (setq en (car en)))
    
52.     (setq i 0 str "")
    
53.     (setq dxf (entget en))
    
54.     (setq EntName (entnext (cdr (assoc -1 dxf))))
    
55.     (while (= (cdr (assoc 0 (setq dxf (entget EntName)))) "ATTRIB")
    
56.       (setq AttValu (cdr (assoc 1 dxf)))
    
57.       (setq str (strcat str AttValu FenGe))
    
58.       (setq EntName (entnext (cdr (assoc -1 dxf))))
    
59.       (setq i (1+ i))
    
60.     )
    
61.     (setq str (substr str 1 (- (strlen str) (strlen FenGe))))
    
62.   )
    
63.   (setq
    
64.     ptlst (GetSolidBox (entsel "\n选择实体:"))
    
65.     zx (nth 0 ptlst)
    
66.     yx (nth 1 ptlst)
    
67.     zs (nth 3 ptlst)
    
68.     nent (nentsel "\n选择图块及轴号图层:")
    
69.     zhtc (get-dxf (car nent) 8)
    
70.     zhkm (get-dxf (car nent) 2)
    
71.     tkty (last (last nent))
    
72.   )
    
73.   (setvar "cmdecho" 0)
    
74.   (vl-cmdf "undo" "m")
    
75.   (vl-cmdf "explode" tkty)
    
76.   (setq ss (ssget "p" (list (cons 0 "INSERT")(cons 8 zhtc))))
    
77.   (foreach ty (ss-enlst ss)
    
78.     (setq
    
79.       pt (get-dxf ty 10)
    
80.       zhx (car pt)
    
81.       zhy (cadr pt)
    
82.     )
    
83.     (if(or
    
84.          (< (car zx) zhx (car yx))
    
85.          (< (cadr zx) zhy (cadr zs))
    
86.        )
    
87.       (if (isAttrClock ty)
    
88.         (setq clst (cons (GetAttValue ty " ") clst))
    
89.       )
    
90.     )
    
91.   )
    
92.   (princ clst)
    
93. (vl-cmdf "undo" "b")
    
94.   (princ)
    
95. )

(defun c:tt (/ *error* clst getattvalue get-dxf getsolidbox isattrclock nent pt ptlst ss ss-enlst tkty ys yx zhkm zhtc zhx zhy zs zx)<br />   (defun *error* (s)<br />     (setq acadver (atof (getvar "acadver")))<br />     (if (> acadver 19.1)<br />       (command-s "undo" "b")<br />     )<br />     (if (<= acadver 19.1)<br />       (command "undo" "b")<br />     )<br />   )<br />   (defun GetSolidBox(ent / LB_pt RT_pt RB_pt LT_pt lst)<br />     (if ent<br />       (progn<br />         (if (= (type ent) 'LIST) (setq ent (car ent)))<br />         (setq ent (vlax-ename->vla-object ent))<br />         (vla-GetBoundingBox ent 'minpoint 'maxpoint)<br />         (setq LB_pt (vlax-safearray->list minpoint))<br />         (setq RT_pt (vlax-safearray->list maxpoint))<br />         (setq RB_pt (list (car RT_pt) (cadr LB_pt)))<br />         (setq LT_pt (list (car LB_pt) (cadr RT_pt)))<br />         (setq lst (list LB_pt RB_pt RT_pt LT_pt))<br />       )<br />     )<br />     lst<br />   )<br />   (defun ss-enlst (ss / enlst)<br />     (cond<br />       ((= (type ss) 'PICKSET)<br />         (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br />       )<br />       ((= (type ss) 'LIST)<br />         (setq enlst (ssadd))<br />         (last (mapcar '(lambda (x) (ssadd x enlst)) ss))<br />       )<br />     )<br />   )<br />   (defun get-dxf(en n)<br />     (if (not (listp en)) (setq en (entget en)))<br />     (cdr (assoc n en))<br />   )<br />   <br />   (defun isAttrClock(ClockName / isTrue)<br />     (if (= (type ClockName) 'LIST) (setq ClockName (car ClockName)))<br />     (setq is (vlax-get-property (vlax-ename->vla-object ClockName) "HasAttributes"))<br />     (if (= is :vlax-true)<br />       T<br />       nil<br />     )<br />   )<br />   (defun GetAttValue (en FenGe / i dxf EntName AttValu str)<br />     (if (= (type en) 'LIST) (setq en (car en)))<br />     (setq i 0 str "")<br />     (setq dxf (entget en))<br />     (setq EntName (entnext (cdr (assoc -1 dxf))))<br />     (while (= (cdr (assoc 0 (setq dxf (entget EntName)))) "ATTRIB")<br />       (setq AttValu (cdr (assoc 1 dxf)))<br />       (setq str (strcat str AttValu FenGe))<br />       (setq EntName (entnext (cdr (assoc -1 dxf))))<br />       (setq i (1+ i))<br />     )<br />     (setq str (substr str 1 (- (strlen str) (strlen FenGe))))<br />   )<br />   (setq<br />     ptlst (GetSolidBox (entsel "\n选择实体:"))<br />     zx (nth 0 ptlst)<br />     yx (nth 1 ptlst)<br />     zs (nth 3 ptlst)<br />     nent (nentsel "\n选择图块及轴号图层:")<br />     zhtc (get-dxf (car nent) 8)<br />     zhkm (get-dxf (car nent) 2)<br />     tkty (last (last nent))<br />   )<br />   (setvar "cmdecho" 0)<br />   (vl-cmdf "undo" "m")<br />   (vl-cmdf "explode" tkty)<br />   (setq ss (ssget "p" (list (cons 0 "INSERT")(cons 8 zhtc))))<br />   (foreach ty (ss-enlst ss)<br />     (setq<br />       pt (get-dxf ty 10)<br />       zhx (car pt)<br />       zhy (cadr pt)<br />     )<br />     (if(or<br />          (< (car zx) zhx (car yx))<br />          (< (cadr zx) zhy (cadr zs))<br />        )<br />       (if (isAttrClock ty)<br />         (setq clst (cons (GetAttValue ty " ") clst))<br />       )<br />     )<br />   )<br />   (princ clst)<br /> (vl-cmdf "undo" "b")<br />   (princ)<br /> )

tender138

飞雪神光 发表于 2024-10-22 20:57
我的思路是
计算实体包围框
然后选择原图的块 undo m标记

高手出马就是不一样！非常感谢！

kozmosovia

逻辑整复杂了，选图元，计算包围盒，角点ssget c获取轴线，轴线首末点各自想两端延伸一点用ssget f获取轴号图块，从图块中提取轴号内容

tender138

kozmosovia 发表于 2024-10-22 22:44
逻辑整复杂了，选图元，计算包围盒，角点ssget c获取轴线，轴线首末点各自想两端延伸一点用ssget f获取轴号 ...

轴网是图块的，请问不打散有什么好办法取轴号？

zdqwy19

(defun c:cc()
  (setq a (cdr(assoc 10 (setq b (entget(car(entsel "选择轴网:")))))))
  (setq c (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))) (cdr(assoc 2 b))))
  (setq i 0 d1 nil d2 nil)
  (repeat(vla-get-Count c)
    (if(= (vla-get-objectname(setq x (vla-item c i))) "AcDbBlockReference")
      (if(= (atoi(setq b (vla-get-textstring(car(vlax-safearray->list(vlax-variant-value(vla-getattributes x))))))) 0)
        (setq d1 (cons (list (cadr(mapcar '+ a (vlax-safearray->list(vlax-variant-value(vla-get-InsertionPoint x))))) b) d1))
        (setq d2 (cons (list (car(mapcar '+ a (vlax-safearray->list(vlax-variant-value(vla-get-InsertionPoint x))))) b) d2))
        )
      )
    (setq i (1+ i))
    )
  (vla-getboundingbox(vlax-ename->vla-object (car (entsel "选择实体:"))) 'p1 'p2)
  (setq f (mapcar '(lambda(x y)(apply x (mapcar y (mapcar 'vlax-safearray->list (list p1 p2))))) '(min max min max) '(car car cadr cadr)))
  (setq e 0)
  (foreach x (reverse d2)
    (if(and(>= (car x) (car f))(<= (car x) (cadr f))) (princ (strcat "横轴交与" (cadr x) "轴")))
    (setq e (1+ e)))
  (setq e 0)
  (foreach x (reverse d1)
    (if(and(>= (car x) (caddr f))(<= (car x) (cadddr f))) (princ (strcat "竖轴交与" (cadr x) "轴")))
    (setq e (1+ e)))
  (princ)
  )

tender138

zdqwy19 发表于 2024-10-23 08:54
(defun c:cc()
  (setq a (cdr(assoc 10 (setq b (entget(car(entsel "选择轴网:")))))))
  (setq c (vla ...

这是好东西，太给力了，非常感谢！