pl线交点附近画圆
想实现这样一个功能，选择任意两条相交的pl线，在距离两条pl各50的位置画一个直径为10的圆，该位置选择是其中的任一个，希望有人帮手一下，谢谢 本帖最后由 Gu_xl 于 2011-7-6 22:08 编辑回复 adc 的帖子
;;;明经通道 编制 By Gu_xl 2011年7月6日
(defun c:tt(/ E1 ENL1 EN1 E2 ENL2 EN2 D P1 STP1 ENP1 P2 STP2 ENP2 P0 ANG MIDANG XJ PT Get3PtAngle Get3PtMidAngle jd)
;;;(Get3PtAngle p1 p2 p3) = 求3点逆时针角度.
;;;参数: p1 p2 p3 点. p2为角点.
;;;返回: 弧度角.
(defun Get3PtAngle (p1 p2 p3 / ans a b an)
(setq ans (list(angle p1 p2)(angle p3 p2))
a (apply 'min ans)
b (apply 'max ans)
an (- b a))
(if (= a (car ans))
an
(- (* 2 PI) an)
)
)
;;;(Get3PtMidAngle p1 p2 p3) 求3点逆时针平分角
(defun Get3PtMidAngle (p1 p2 p3 / ang1 JiaJiao)
(setq ang1 (angle p2 p1)
JiaJiao (Get3PtAngle p1 p2 p3)
)
(if (> (setq ang1 (+ ang1 (* 0.5 JiaJiao))) (* 2 pi)) (- ang1 (* 2 pi)) ang1)
)
(if (and
(setq e1 (entsel "\n 直线1: "))
(WCMATCH(cdr (assoc 0 (setq enl1 (entget (setq en1 (car e1)))))) "*LINE")
(progn (redraw en1 3) (setq e2 (entsel "\n 直线2: ")))
(WCMATCH (cdr (assoc 0 (setq enl2 (entget (setq en2 (car e2)))))) "*LINE")
)
(progn
(redraw en2 3)
;(setq d (getreal "\n垂距<50.0>: "))
(if (null d) (setq d 50.0))
(setq p1 (vlax-curve-getclosestpointto en1 (trans (cadr e1) 1 0))
p2 (vlax-curve-getclosestpointto en2 (trans (cadr e2) 1 0))
)
(setq pl (vlax-invoke (vlax-ename->vla-object en1) 'IntersectWith (vlax-ename->vla-object en2) acExtendNone))
(while pl
(setq p0 (cons (list (car pl) (cadr pl) (caddr pl)) p0)
pl (cdddr pl)
)
)
;;; 计算共线的交点
(vl-some
'(lambda (x)
(if (and
(or (= "LINE" (cdr (assoc 0 enl1)))
(equal (fix (vlax-curve-getParamAtPoint en1 x))
(fix (vlax-curve-getParamAtPoint en1 p1))
)
)
(or (= "LINE" (cdr (assoc 0 enl2)))
(equal (fix (vlax-curve-getParamAtPoint en2 x))
(fix (vlax-curve-getParamAtPoint en2 p2))
)
)
)
(setq jd x)
)
)
p0
)
(setq p0 jd)
(if (not
(or
(equal p1 p2 1e-6)
(equal p1 p0 1e-6)
(equal p0 p2 1e-6)
(not p0)
)
)
(progn
;(setq p0 (inters stp1 enp1 stp2 enp2 nil))
(setq ang (Get3PtAngle p1 p0 p2)
midang (Get3PtMidAngle p1 p0 p2)
)
(setq xj (/ d (sin (/ ang 2.0))))
(setq pt (polar p0 midang xj))
(entmake (list '(0 . "circle") (cons 10 pt) (cons 40 10)))
(entmake (list '(0 . "line") (cons 10 pt) (cons 11 (vlax-curve-getclosestpointto en1 pt))))
(entmake (list '(0 . "line") (cons 10 pt) (cons 11 (vlax-curve-getclosestpointto en2 pt))))
)
(alert "点重合，无法生成图形！")
)
(redraw en1 4)
(redraw en2 4)
)
)
)
Gu_xl 发表于 2011-7-6 20:26 static/image/common/back.gif
回复 adc 的帖子
测试不正确!最麻烦是角度问题.....
另一种方法就是用辅助线来求圆心坐标,程序最简单 回复 ljpnb 的帖子
有什么问题？？？？
我测试没问题！ 本帖最后由 adc 于 2011-7-6 21:41 编辑
回复 Gu_xl 的帖子
原来是逆时针选择才能在夹角范围内生成，不过不同ucs下不行
;;在两相交直线的角平分线上画圆 by ljpnb 2011-7-6
(defun c:tt ()
(if (and (setq en1 (entsel "\n选择第一条相交线:"))
(setq en2 (entsel "\n选择第二条相交线:"))
;;(setq d (getreal "\n输入距边线的距离:"))
)
(progn
(setq ent1 (car en1)
p1 (osnap (cadr en1) "nea")
ent2 (car en2)
p2 (osnap (cadr en2) "nea")
)
(setq obj1 (vlax-Ename->Vla-Object ent1)
obj2 (vlax-Ename->Vla-Object ent2)
)
(setq lst (vla-IntersectWith obj1 obj2 acExtendNone))
(setq p0 (vlax-safearray->list (vlax-variant-value lst)))
(setq ang1 (angle p0 p1)
ang2 (angle p0 p2)
)
(cond ((and (< ang1 pi) (> ang2 (+ ang1 pi)))
(setq ang1 (+ ang1 (* pi 2)))
)
((and (> ang1 pi) (< ang2 (- ang1 pi)))
(setq ang2(+ ang2 (* pi 2)))
)
(T)
)
(setq ang (/ (abs (- ang1 ang2)) 2.))
(if (> ang1 ang2)
(setq ang0 ang2)
(setq ang0 ang1)
)
(setq L (/ 50 (sin ang)))
(setq p3 (polar p0 (+ ang0 ang) L))
(entmake (list '(0 . "circle") (cons 10 p3) (cons 40 10)))
(entmake (list '(0 . "line") (cons 10 p3) (cons 11 (vlax-curve-getclosestpointto ent1 p3))))
(entmake (list '(0 . "line") (cons 10 p3) (cons 11 (vlax-curve-getclosestpointto ent2 p3))))
)
)
(princ)
)
本帖最后由 Gu_xl 于 2011-7-6 22:00 编辑
回复 adc 的帖子
使用技巧：选择点应靠近直线端点一侧，并按逆时针计算角度！园绘制在靠近直线端点侧！
本帖最后由 Gu_xl 于 2011-7-6 22:09 编辑
回复 adc 的帖子
二楼已修正ucs问题！ Gu_xl 版的程序按"要求"测试结果是对的,提个建议,就是考虑一下点选的随意性........ 回复 ljpnb 的帖子
做什么事儿都要有规则！没有规矩，不成方圆！
太随意了，结果也会很随意！
页:
[1]
2