大家谁帮着写一个把带圈数字移动到最近端点的lisp
如题,大家谁帮着写一个把带圈数字移动到最近端点的lisp。 首先，想对楼主说一句话，起码的谢谢要有吧，谁也不欠你的....其次呢，你应该说明你的对象是 带圆的文字 还是块还有就是那个是直线还是多段线...
正确的描述才能得到所需的帮助！ (defun c:tt (/);靠近圆和圆内文字移动到两线没有相交的端点
(prompt "选择图形")
(setq app nil)
(setq ss (ssget))
(command "select" ss "")
(setq ss-line (ssget "p" '((0 . "*LINE"))))
(setq na-1 (ssname ss-line 0))
(setq pta (vlax-curve-getstartpoint na-1))
(setq ptb (vlax-curve-getendpoint na-1))
(setq na-2 (ssname ss-line 1))
(setq ptaa (vlax-curve-getstartpoint na-2))
(setq ptbb (vlax-curve-getendpoint na-2))
(if (equal pta ptaa 5)
(setq lis (list ptb ptbb))
(progn
(if (equal pta ptbb 5)
(setq lis (list ptb ptaa))
(progn
(if (equal ptb ptaa 5)
nil
(setq lis (list pta ptaa))
)
)
)
)
)
(setq lis (vl-sort lis
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
(command "select" ss "")
(setq ss-CIRCLE (ssget "p" '((0 . "CIRCLE"))))
(setq ii 0)
(repeat (sslength ss-CIRCLE)
(setq name (ssname ss-CIRCLE ii)
ii (1+ ii)
cen(cdr (assoc 40 (entget name)))
)
(setq app (append (list (append (list cen) (list name))) app))
)
(setq app (vl-sort app
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
(mapcar '(lambda (x y)
(vl-cmdf "move"
(sss (cadr y))
""
(cdr (assoc 10 (entget (cadr y))))
x
)
)
lis
app
)
)
(defun sss (na / cen en pt- pt+ pt< pt> rad ss)
(setq en (entget na))
(setq rad (cdr (assoc 40 en)))
(setq cen (cdr (assoc 10 en)))
(setq pt> (polar cen 0 (1+ rad)))
(setq pt< (polar cen pi (1+ rad)))
(setq pt+ (polar cen (* 0.5 pi) (1+ rad)))
(setq pt- (polar cen (* 1.5 pi) (1+ rad)))
(setq ss (ssget "cp" (list pt> pt+ pt< pt-)))
) 哦，谢谢楼上各位，谢谢434939575兄帮忙。 分别为圆和数字，线是L线，谢谢cdma2546兄。 测试了上面老师的程序，加载后，输入命令，不能运行。
页:
[1]