[求助]过样条曲线与一直线的交点做样条曲线的切线！

柯梦楠

[求助] 1、过样条曲线与一直线的交点做样条曲线的切线！ 2、在样条曲线上绘制等分点，可以插入块，可不可以在指定点插入块，并且该块与样条曲线对齐？

meflying

1.如下:

2. ;函数:GetInterPOint
3. ;功能:返回两个对象的所有交点
4. ;参数: ent1、ent2 均为ename对象
5. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
6.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
7.                ax_ent_2 (vlax-ename->vla-object ent2)
8.    )
9.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
10.    (setq intpoints (vlax-variant-value intpoints))
11.    (setq i 0)
12.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
13.        (repeat (/ (+ 1
14.                            (- (vlax-safearray-get-u-bound intpoints 1)
15.                                  (vlax-safearray-get-l-bound intpoints 1)
16.                            )
17.                      )
18.                      3
19.                )
20.            (setq points (append points (list (list
21.                (vlax-safearray-get-element intpoints i)
22.                (vlax-safearray-get-element intpoints (+ i 1))
23.                (vlax-safearray-get-element intpoints (+ i 2))
24.            )))
25.            )
26.            (setq i (+ 3 i))
27.        )
28.    )
29.    points
30. )
31. ;主函数，命令：TEST
32. (defun c:test( / ent1 ent2 pts i pt ang)
33.    (setq ent1 (car (entsel "\n选择曲线...")))
34.    (setq ent2 (car (entsel "\n选择直线...")))
35.    (setq pts (GetInterPoint ent1 ent2))
36.    (setq i 0)
37.    (repeat (length pts)
38.        (setq pt (nth i pts))
39.        (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt))))
40.        (command "_.line" pt (polar pt ang 100) "")
41.        (setq i (1+ i))
42.    )
43.    (princ)
44. )

;函数:GetInterPOint ;功能:返回两个对象的所有交点 ;参数: ent1、ent2 均为ename对象 (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)    (setq ax_ent_1 (vlax-ename->vla-object ent1)                ax_ent_2 (vlax-ename->vla-object ent2)    )    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))    (setq intpoints (vlax-variant-value intpoints))    (setq i 0)    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)        (repeat (/ (+ 1                            (- (vlax-safearray-get-u-bound intpoints 1)                                  (vlax-safearray-get-l-bound intpoints 1)                            )                      )                      3                )            (setq points (append points (list (list                (vlax-safearray-get-element intpoints i)                (vlax-safearray-get-element intpoints (+ i 1))                (vlax-safearray-get-element intpoints (+ i 2))            )))            )            (setq i (+ 3 i))        )    )    points ) ;主函数，命令：TEST (defun c:test( / ent1 ent2 pts i pt ang)    (setq ent1 (car (entsel "\n选择曲线...")))    (setq ent2 (car (entsel "\n选择直线...")))    (setq pts (GetInterPoint ent1 ent2))    (setq i 0)    (repeat (length pts)        (setq pt (nth i pts))        (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt))))        (command "_.line" pt (polar pt ang 100) "")        (setq i (1+ i))    )    (princ) )

2.怎样算对齐?

柯梦楠

样条曲线，定数等分，插入块，对齐！



实际上和第一个问题是一样的，就是沿着插入点的切线方向排列插入的图形！


如下图！但我要的是任意点或确定点，比如说与其它对象的交点！这样的点不止一个！且没有排列的规则！

meflying

到底是什么点?如果等分点,divide命令就可以办到

柯梦楠

我上面的就是用定数等分做的！


就因为不是等分点，而是与其它对象相交的点，这些交点当然是任意的，说不准在哪！而且点很多。每个点都要插入一个图形与样条曲线对齐！

meflying

2. ;函数:GetInterPOint
3. ;功能:返回两个对象的所有交点
4. ;参数: ent1、ent2 均为ename对象
5. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
6.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
7.                ax_ent_2 (vlax-ename->vla-object ent2)
8.    )
9.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
10.    (setq intpoints (vlax-variant-value intpoints))
11.    (setq i 0)
12.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
13.        (repeat (/ (+ 1
14.                            (- (vlax-safearray-get-u-bound intpoints 1)
15.                                  (vlax-safearray-get-l-bound intpoints 1)
16.                            )
17.                      )
18.                      3
19.                )
20.            (setq points (append points (list (list
21.                (vlax-safearray-get-element intpoints i)
22.                (vlax-safearray-get-element intpoints (+ i 1))
23.                (vlax-safearray-get-element intpoints (+ i 2))
24.            )))
25.            )
26.            (setq i (+ 3 i))
27.        )
28.    )
29.    points
30. )
31. ;主函数，命令：TEST
32. ;功能：交点画切线
33. (defun c:test( / ent1 ent2 pts i pt ang)
34.    (setq ent1 (car (entsel "\n选择曲线...")))
35.    (setq ent2 (car (entsel "\n选择直线...")))
36.    (setq pts (GetInterPoint ent1 ent2))
37.    (setq i 0)
38.    (repeat (length pts)
39.        (setq pt (nth i pts))
40.        (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt))))
41.        (command "_.line" pt (polar pt ang 100) "")
42.        (setq i (1+ i))
43.    )
44.    (princ)
45. )
46. ;命令:test2
47. ;功能：交点插入块
48. (defun c:test2( / ent1 ent2 pts i pt ang blk)
49.    (setq ent1 (car (entsel "\n选择曲线...")))
50.    (setq ent2 (car (entsel "\n选择直线...")))
51.    (setq blk (getstring "\n输入块名:"))
52.    (setq pts (GetInterPoint ent1 ent2))
53.    (setq i 0)
54.    (repeat (length pts)
55.        (setq pt (nth i pts))
56.        (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt))))
57.        (command "insert" blk pt "" "" (angtos ang))
58.        (setq i (1+ i))
59.    )
60.    (princ)
61. )

;函数:GetInterPOint ;功能:返回两个对象的所有交点 ;参数: ent1、ent2 均为ename对象 (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)    (setq ax_ent_1 (vlax-ename->vla-object ent1)                ax_ent_2 (vlax-ename->vla-object ent2)    )    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))    (setq intpoints (vlax-variant-value intpoints))    (setq i 0)    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)        (repeat (/ (+ 1                            (- (vlax-safearray-get-u-bound intpoints 1)                                  (vlax-safearray-get-l-bound intpoints 1)                            )                      )                      3                )            (setq points (append points (list (list                (vlax-safearray-get-element intpoints i)                (vlax-safearray-get-element intpoints (+ i 1))                (vlax-safearray-get-element intpoints (+ i 2))            )))            )            (setq i (+ 3 i))        )    )    points ) ;主函数，命令：TEST ;功能：交点画切线 (defun c:test( / ent1 ent2 pts i pt ang)    (setq ent1 (car (entsel "\n选择曲线...")))    (setq ent2 (car (entsel "\n选择直线...")))    (setq pts (GetInterPoint ent1 ent2))    (setq i 0)    (repeat (length pts)        (setq pt (nth i pts))        (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt))))        (command "_.line" pt (polar pt ang 100) "")        (setq i (1+ i))    )    (princ) ) ;命令:test2 ;功能：交点插入块 (defun c:test2( / ent1 ent2 pts i pt ang blk)    (setq ent1 (car (entsel "\n选择曲线...")))    (setq ent2 (car (entsel "\n选择直线...")))    (setq blk (getstring "\n输入块名:"))    (setq pts (GetInterPoint ent1 ent2))    (setq i 0)    (repeat (length pts)        (setq pt (nth i pts))        (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt))))        (command "insert" blk pt "" "" (angtos ang))        (setq i (1+ i))    )    (princ) )