引用EasyCAD的回答：
(defun c:tes ( / &ss #si #sn #kw &cs )
(if (null vlax-dump-object) (vl-load-com) )
(if (null &mod) (setq &mod (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) )
(if (null #ofs) (setq #ofs 40) )
(if (setq #nfs (getreal (strcat "\n请输入筛选距离: "))) (setq #ofs #nfs) (setq #nfs #ofs) )
(if (setq &ss (ssget (list (cons 0 "TEXT") (cons -4 ""))))
(progn
(repeat (setq #si 0 @sa '() @nv '() #sn (sslength &ss))
(setq &cs (vlax-ename->vla-object (ssname &ss #si)) #si (1+ #si))
($jt-drawtextbox &cs 1)
)
(foreach rec (append @sa @nv) (if (not (vlax-erased-p rec)) (vla-erase rec) ) )
)
(princ "\n未选中文字对象,程序退出!")
)
(princ)
)
(defun $jt-drawtextbox ( &tx #mo / p1 p2 p3 p4 lis dou pol &rec &vs #vi #vn #mx &cv #cm &nv )
(vla-getboundingbox &tx 'p1 'p2)
(setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
(setq p3 (list (car p1) (cadr p2)) p4 (list (car p2) (cadr p1)) pts (list p1 p3 p2 p4 p1))
(setq lis (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts)))
(setq dou (vlax-make-safearray vlax-vbdouble (cons 0 (1- (* 2 (length pts))))))
(setq lis (vlax-make-variant (vlax-safearray-fill dou lis)))
(setq &rec (vla-addlightweightpolyline &mod lis) @sa (cons &rec @sa))
(if (= #mo 1)
(progn
(setq p1 (polar p1 (* pi 1.25) #nfs) p2 (polar p2 (* pi 0.25) #nfs))
(setq p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)))
(if (setq &vs (ssget "C" p1 p2 (list (cons 0 "TEXT") (cons 1 "(*X*)"))))
(progn
(repeat (setq #vi 0 #mx 1000 #vn (sslength &vs))
(setq &cv (vlax-ename->vla-object (ssname &vs #vi)) #vi (1+ #vi))
(if (not (member &cv @nv))
(progn
(setq #cm (vlax-curve-getclosestpointto ($jt-drawtextbox &cv 0) p3))
(if (< (setq #cm (distance p3 #cm)) #mx) (setq #mx #cm &nv &cv) )
)
)
)
(if &nv
(progn
(vla-put-textstring &tx (strcat (vla-get-textstring &tx) (vla-get-textstring &nv)))
(vla-put-color &nv 1) (setq @nv (cons &nv @nv))
)
)
)
)
)
)
&rec
)
试下上面的程序吧,命令是 tes
展开全部
上面的程序是不能合并，并不是提问者所想要的东西
已赞过
已踩过<
你对这个回答的评价是？
评论
收起
扫一扫
411
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
