如何作块内曲线的切线？

tm20038175

回复 ZZXXQQ 的帖子

很好的近似，谢谢…………
今天是党的生日，写在今天这个特别的日子！……

edoumxx

用起来很方便，不用每次都先画圆心再画半径，才能画切线了

highflybird

老实地说，如果想得到一个正确的画块内曲线切线的程序，还是要考虑很多问题的。
譬如，UCS ，嵌套块，非等比缩放块，旋转的块，法线不是'(0 0 1)的块，切线长度满足要求，nentselp如果返回的图元不是曲线，以及支持捕捉等等，这些细节都应该考虑到。

GU_xl 和ZZXXQQ他们的方法很好，但是还是存在一定的bug. 读者可以自行验证。

下面我给出程序，不仅能画出一般曲线的切线，而且也能画处块（包括嵌套块）内曲线的切线。程序参考了国外Gile的一些片段，在此感谢。

1. (prompt "\n命令为Test,你可自行修改.右键或者回车退出.")
   
2. (vl-load-com)
   
3. (defun c:test (/ an Bs en LST m pp P0 P1 P2 P3 P4 P5 P6 vt rt D L S)
   
4.   (defun CheckIsCurve(en / dxf typ)     ;检查是否是曲线
   
5.     (and
   
6.       en        ;存在实体
   
7.       (setq dxf (entget en))      ;DXF码
   
8.       (setq typ (cdr (assoc 0 dxf)))     ;图元类型
   
9.       (or (member typ '("ELLIPSE" "CIRCLE" "ARC" "RAY"))  
   
10.           (wcmatch typ "*LINE")
    
11.       )
    
12.     )
    
13.   )
    
14.   
    
15.   (initget 14)
    
16.   (setq L (getdist "\n输入要画切线长度<1000>:"))
    
17.   (and (null L) (setq L 1000))
    
18.   (setq L (/ L 2))
    
19.   
    
20.   (while (setq P0 (getpoint "\n曲线上的一点:"))      
    
21.     (setq lst (nentselp P0))
    
22.     (setq en (car lst))       ;光标处图元
    
23.     (if (CheckIsCurve en)
    
24.       (setq P0 (cadr lst)      ;光标点
    
25.      m  (caddr lst)      ;变换矩阵
    
26.      Bs (cadddr lst)      ;块参照列表(可能有嵌套)
    
27.      P1 (TransNested P0 Bs 1 2)      ;把点变换到图块坐标系
    
28.      P1 (vlax-curve-getclosestpointto en P1)   ;得到最近点
    
29.      pp (vlax-curve-getParamAtPoint en P1)   ;得到这点参数
    
30.      vt (vlax-curve-getFirstDeriv en pp)    ;得到切线
    
31.        an (angle '(0 0 0) vt)            ;切线角
    
32.      P3 (mapcar '+ P1 vt)     ;切线端点(RCS)
    
33.      P4 (mapcar '- P1 vt)     ;切线端点(RCS)
    
34.      p2 (TransNested P1 Bs 2 0)     ;切点
    
35.      P5 (TransNested P3 Bs 2 0)     ;切线端点(WCS)
    
36.      P6 (transNested P4 Bs 2 0)     ;切线端点(WCS)
    
37.            ;到上面其实已知道切线了
    
38.      d  (distance p2 p5)      ;下面用来求出满足长度的切线两点
    
39.      S  (/ L D)
    
40.      S  (list (- 1 S) S)      ;定比分点
    
41.      P5 (mxv (trp (list p2 p5)) S)
    
42.      P6 (mxv (trp (list p2 p6)) S)
    
43.      rt (entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p6))) ;画切线;rt (makeXLine p2 (mapcar '- p5 p6))
    
44.      
    
45.       )
    
46.       (princ "\n你没点中或者此处不是曲线类物体!")
    
47.     )
    
48.   )
    
49.   (princ)
    
50. )

(prompt "\n命令为Test,你可自行修改.右键或者回车退出.")<br /> (vl-load-com)<br /> (defun c:test (/ an Bs en LST m pp P0 P1 P2 P3 P4 P5 P6 vt rt D L S)<br />   (defun CheckIsCurve(en / dxf typ)     ;检查是否是曲线<br />     (and<br />       en        ;存在实体<br />       (setq dxf (entget en))      ;DXF码<br />       (setq typ (cdr (assoc 0 dxf)))     ;图元类型<br />       (or (member typ '("ELLIPSE" "CIRCLE" "ARC" "RAY"))  <br />           (wcmatch typ "*LINE")<br />       )<br />     )<br />   )<br />   <br />   (initget 14)<br />   (setq L (getdist "\n输入要画切线长度<1000>:"))<br />   (and (null L) (setq L 1000))<br />   (setq L (/ L 2))<br />   <br />   (while (setq P0 (getpoint "\n曲线上的一点:"))       <br />     (setq lst (nentselp P0))<br />     (setq en (car lst))       ;光标处图元<br />     (if (CheckIsCurve en)<br />       (setq P0 (cadr lst)      ;光标点<br />      m  (caddr lst)      ;变换矩阵<br />      Bs (cadddr lst)      ;块参照列表(可能有嵌套)<br />      P1 (TransNested P0 Bs 1 2)      ;把点变换到图块坐标系<br />      P1 (vlax-curve-getclosestpointto en P1)   ;得到最近点<br />      pp (vlax-curve-getParamAtPoint en P1)   ;得到这点参数<br />      vt (vlax-curve-getFirstDeriv en pp)    ;得到切线<br />        an (angle '(0 0 0) vt)            ;切线角<br />      P3 (mapcar '+ P1 vt)     ;切线端点(RCS)<br />      P4 (mapcar '- P1 vt)     ;切线端点(RCS)<br />      p2 (TransNested P1 Bs 2 0)     ;切点<br />      P5 (TransNested P3 Bs 2 0)     ;切线端点(WCS)<br />      P6 (transNested P4 Bs 2 0)     ;切线端点(WCS)<br />            ;到上面其实已知道切线了<br />      d  (distance p2 p5)      ;下面用来求出满足长度的切线两点<br />      S  (/ L D)<br />      S  (list (- 1 S) S)      ;定比分点<br />      P5 (mxv (trp (list p2 p5)) S)<br />      P6 (mxv (trp (list p2 p6)) S)<br />      rt (entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p6))) ;画切线;rt (makeXLine p2 (mapcar '- p5 p6))<br />      <br />       )<br />       (princ "\n你没点中或者此处不是曲线类物体!")<br />     )<br />   )<br />   (princ)<br /> )

完整的代码请见附件：

highflybir

回复 tm20038175 的帖子

这是动画演示

mandala

回复 highflybird 的帖子
非常好的程序，谢谢。

tm20038175

回复 highflybird 的帖子

这么好的程序，不得不狂顶。。。。

今天开始，我要连续顶至少一个星期，感谢大师给我们带来了如此完美的程序！………

tm20038175

顶一个。。。。…………

tm20038175

在顶一个，这么好的程序。。。。。

tm20038175

继续顶，好程序，顶满一个星期。。。。

祥子

大师出馬,的确与众不同, 这样大家又学了很多东西,希望大师们经常发表高见啊