回复 ZZXXQQ 的帖子
很好的近似，谢谢…………
今天是党的生日，写在今天这个特别的日子！……
用起来很方便，不用每次都先画圆心再画半径，才能画切线了
本帖最后由 highflybird 于 2011-7-6 03:15 编辑
老实地说，如果想得到一个正确的画块内曲线切线的程序，还是要考虑很多问题的。
譬如，UCS ，嵌套块，非等比缩放块，旋转的块，法线不是'(0 0 1)的块，切线长度满足要求，nentselp如果返回的图元不是曲线，以及支持捕捉等等，这些细节都应该考虑到。
GU_xl 和ZZXXQQ他们的方法很好，但是还是存在一定的bug. 读者可以自行验证。
下面我给出程序，不仅能画出一般曲线的切线，而且也能画处块（包括嵌套块）内曲线的切线。程序参考了国外Gile的一些片段，在此感谢。
(prompt "\n命令为Test,你可自行修改.右键或者回车退出.")
(vl-load-com)
(defun c:test (/ an Bs en LST m pp P0 P1 P2 P3 P4 P5 P6 vt rt D L S)
(defun CheckIsCurve(en / dxf typ) ;检查是否是曲线
(and
en ;存在实体
(setq dxf (entget en)) ;DXF码
(setq typ (cdr (assoc 0 dxf))) ;图元类型
(or (member typ '("ELLIPSE" "CIRCLE" "ARC" "RAY"))
(wcmatch typ "*LINE")
)
)
)
(initget 14)
(setq L (getdist "\n输入要画切线长度<1000>:"))
(and (null L) (setq L 1000))
(setq L (/ L 2))
(while (setq P0 (getpoint "\n曲线上的一点:"))
(setq lst (nentselp P0))
(setq en (car lst)) ;光标处图元
(if (CheckIsCurve en)
(setq P0 (cadr lst) ;光标点
m(caddr lst) ;变换矩阵
Bs (cadddr lst) ;块参照列表(可能有嵌套)
P1 (TransNested P0 Bs 1 2) ;把点变换到图块坐标系
P1 (vlax-curve-getclosestpointto en P1) ;得到最近点
pp (vlax-curve-getParamAtPoint en P1) ;得到这点参数
vt (vlax-curve-getFirstDeriv en pp) ;得到切线
an (angle '(0 0 0) vt) ;切线角
P3 (mapcar '+ P1 vt) ;切线端点(RCS)
P4 (mapcar '- P1 vt) ;切线端点(RCS)
p2 (TransNested P1 Bs 2 0) ;切点
P5 (TransNested P3 Bs 2 0) ;切线端点(WCS)
P6 (transNested P4 Bs 2 0) ;切线端点(WCS)
;到上面其实已知道切线了
d(distance p2 p5) ;下面用来求出满足长度的切线两点
S(/ L D)
S(list (- 1 S) S) ;定比分点
P5 (mxv (trp (list p2 p5)) S)
P6 (mxv (trp (list p2 p6)) S)
rt (entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p6))) ;画切线;rt (makeXLine p2 (mapcar '- p5 p6))
)
(princ "\n你没点中或者此处不是曲线类物体!")
)
)
(princ)
)
完整的代码请见附件：
回复 tm20038175 的帖子
这是动画演示
本帖最后由 mandala 于 2011-7-6 09:47 编辑
回复 highflybird 的帖子
非常好的程序，谢谢。
回复 highflybird 的帖子
这么好的程序，不得不狂顶。。。。
今天开始，我要连续顶至少一个星期，感谢大师给我们带来了如此完美的程序！………
顶一个。。。。…………
在顶一个，这么好的程序。。。。。
继续顶，好程序，顶满一个星期。。。。
大师出馬,的确与众不同, 这样大家又学了很多东西,希望大师们经常发表高见啊