点选实体获取轴号，麻烦各位大师帮忙优化完善，谢谢！
本帖最后由 tender138 于 2024-10-22 20:43 编辑原贴：请问各位大师如何获取与实体相交的轴号？重复麻烦版主删除，谢谢 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz!特别鸣谢你有种再说一遍
东拼西凑搞了个《点选实体获取轴号》，其中引用了之前收集的各位大师函数，具体贵号忘记了，在此一并致谢！！！
现在我是按附件“Drawing1.dwg”测试的，基本能实现要求，但是不通用，设定的特定条件为：
1、轴线在“AXIS”图层，轴号在“AXIS_NUM”图层（通用应该提示选图层）
2、轴线为直线（通用应该各种类型线均可）
3、轴线已经与轴号相交了（通用应该绘制构造线或射线延伸相交？）
4、轴网、轴号已经打散（原图为块）
现在希望各位大师能帮忙优化完善使之能在附件“Drawing2.dwg”中测试通过，在此先致谢！
本帖最后由 飞雪神光 于 2024-10-22 21:37 编辑
我的思路是
计算实体包围框
然后选择原图的块 undo m标记
分解块 获取分解后的选择集
筛选属性轴号
遍历轴号的X值与Y值 与实体包围框的 X范围与Y范围进行比对
不需要轴线的参与 也没有屏幕外ssget失灵的问题
完成后undo b 还原块
因为用到了 nentsel 所以 "选择图块及轴号图层"是要点击块内轴号的文字 也可以改成分开获取图块图元和轴号图层
(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)
(defun *error* (s)
(setq acadver (atof (getvar "acadver")))
(if (> acadver 19.1)
(command-s "undo" "b")
)
(if (<= acadver 19.1)
(command "undo" "b")
)
)
(defun GetSolidBox(ent / LB_pt RT_pt RB_pt LT_pt lst)
(if ent
(progn
(if (= (type ent) 'LIST) (setq ent (car ent)))
(setq ent (vlax-ename->vla-object ent))
(vla-GetBoundingBox ent 'minpoint 'maxpoint)
(setq LB_pt (vlax-safearray->list minpoint))
(setq RT_pt (vlax-safearray->list maxpoint))
(setq RB_pt (list (car RT_pt) (cadr LB_pt)))
(setq LT_pt (list (car LB_pt) (cadr RT_pt)))
(setq lst (list LB_pt RB_pt RT_pt LT_pt))
)
)
lst
)
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
(defun get-dxf(en n)
(if (not (listp en)) (setq en (entget en)))
(cdr (assoc n en))
)
(defun isAttrClock(ClockName / isTrue)
(if (= (type ClockName) 'LIST) (setq ClockName (car ClockName)))
(setq is (vlax-get-property (vlax-ename->vla-object ClockName) "HasAttributes"))
(if (= is :vlax-true)
T
nil
)
)
(defun GetAttValue (en FenGe / i dxf EntName AttValu str)
(if (= (type en) 'LIST) (setq en (car en)))
(setq i 0 str "")
(setq dxf (entget en))
(setq EntName (entnext (cdr (assoc -1 dxf))))
(while (= (cdr (assoc 0 (setq dxf (entget EntName)))) "ATTRIB")
(setq AttValu (cdr (assoc 1 dxf)))
(setq str (strcat str AttValu FenGe))
(setq EntName (entnext (cdr (assoc -1 dxf))))
(setq i (1+ i))
)
(setq str (substr str 1 (- (strlen str) (strlen FenGe))))
)
(setq
ptlst (GetSolidBox (entsel "\n选择实体:"))
zx (nth 0 ptlst)
yx (nth 1 ptlst)
zs (nth 3 ptlst)
nent (nentsel "\n选择图块及轴号图层:")
zhtc (get-dxf (car nent) 8)
zhkm (get-dxf (car nent) 2)
tkty (last (last nent))
)
(setvar "cmdecho" 0)
(vl-cmdf "undo" "m")
(vl-cmdf "explode" tkty)
(setq ss (ssget "p" (list (cons 0 "INSERT")(cons 8 zhtc))))
(foreach ty (ss-enlst ss)
(setq
pt (get-dxf ty 10)
zhx (car pt)
zhy (cadr pt)
)
(if(or
(< (car zx) zhx (car yx))
(< (cadr zx) zhy (cadr zs))
)
(if (isAttrClock ty)
(setq clst (cons (GetAttValue ty " ") clst))
)
)
)
(princ clst)
(vl-cmdf "undo" "b")
(princ)
)
飞雪神光 发表于 2024-10-22 20:57
我的思路是
计算实体包围框
然后选择原图的块 undo m标记
高手出马就是不一样！非常感谢！ 逻辑整复杂了，选图元，计算包围盒，角点ssget c获取轴线，轴线首末点各自想两端延伸一点用ssget f获取轴号图块，从图块中提取轴号内容 kozmosovia 发表于 2024-10-22 22:44
逻辑整复杂了，选图元，计算包围盒，角点ssget c获取轴线，轴线首末点各自想两端延伸一点用ssget f获取轴号 ...
轴网是图块的，请问不打散有什么好办法取轴号？ (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)
) zdqwy19 发表于 2024-10-23 08:54
(defun c:cc()
(setq a (cdr(assoc 10 (setq b (entget(car(entsel "选择轴网:")))))))
(setq c (vla ...
这是好东西，太给力了，非常感谢！
页:
[1]