[求助]请帮忙编这个程序

wengsg

在原有图的两条样条曲线上，先选择①，后选择②，最终形成③形状的“示坡线”，如有哪位大虾帮忙，我将感激不尽！！

meflying

2. ;函数:GetInterPOint
3. ;功能:返回两个对象的所有交点
4. ;参数:  ent1、ent2  均为ename对象
5. (vl-load-com)
6. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
7.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
8.                ax_ent_2 (vlax-ename->vla-object ent2)
9.    )
10.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
11.    (setq intpoints (vlax-variant-value intpoints))
12.    (setq i 0)
13.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
14.        (repeat (/ (+ 1
15.                            (- (vlax-safearray-get-u-bound intpoints 1)
16.                                  (vlax-safearray-get-l-bound intpoints 1)
17.                            )
18.                      )
19.                      3
20.                )
21.            (setq points (append points (list (list
22.                (vlax-safearray-get-element intpoints i)
23.                (vlax-safearray-get-element intpoints (+ i 1))
24.                (vlax-safearray-get-element intpoints (+ i 2))
25.            )))
26.            )
27.            (setq i (+ 3 i))
28.        )
29.    )
30.    points
31. )(defun err(msg)
32.    (princ msg)
33.    (setvar "osmode" os)
34.    (setvar "cmdecho" cmd)
35.    (setq *error* errtmp)
36.    (command "_.undo" "e")
37.    (princ)
38. )(defun c:test( / ent1 ent2 entv1 entv2 pts param11 param12 param21 param22 param1 param2 i n2 pt1 pt2)   
39.    (setq os (getvar "osmode"))
40.    (setq cmd (getvar "cmdecho"))
41.    (command "_.undo" "be")
42.    (setvar "osmode" 0)
43.    (setvar "cmdecho" 0)
44.    (setq errtmp *error*)
45.    (setq *error* err)
46.    (setq ent1 (car (entsel "\nSelect the first line...")))
47.    (setq ent2 (car (entsel "\nSelect the second line...")))
48.    (if (not n)
49.        (setq n (getint "\n输入密度:"))
50.        (progn (setq n2 (getint (strcat "\n输入密度<" (itoa n) ">:")))
51.            (if n2
52.   (setq n n2)
53.            )
54.        )
55.    )
56.    (setq pts (GetInterpoint ent1 ent2))
57.    (setq entv1 (vlax-ename->vla-object ent1))
58.    (setq entv2 (vlax-ename->vla-object ent2))
59.    (setq param11 (vlax-curve-getParamAtPoint entv1 (car pts)))
60.    (setq param12 (vlax-curve-getParamAtPoint entv1 (cadr pts)))
61.    (setq param21 (vlax-curve-getParamAtPoint entv2 (car pts)))
62.    (setq param22 (vlax-curve-getParamAtPoint entv2 (cadr pts)))
63.    (setq i 1)
64.    (setq param1 (/ (- param12 param11) n))
65.    (setq param2 (/ (- param22 param21) n))
66.    (repeat (1- n)
67.        (setq pt1 (vlax-curve-getPointAtParam ent1 (+ param11 (* param1 i))))
68.        (setq pt2 (vlax-curve-getPointAtParam ent2 (+ param21 (* param2 i))))
69.        (if (= (* (/ i 2) 2) i)
70.            (setq pt2 (list (/ (+ (car pt1) (car pt2)) 2.0)
71.                (/ (+ (cadr pt1) (cadr pt2)) 2.0)
72.                (/ (+ (last pt1) (last pt2)) 2.0)
73.                ))
74.        )
75.        (command "_.line" pt1 pt2 "")
76.        (setq i (1+ i))
77.    )
78.    (setvar "osmode" os)
79.    (setvar "cmdecho" cmd)
80.    (setq *error* errtmp)
81.    (command "_.undo" "e")
82.    (princ)
83. )

;函数:GetInterPOint ;功能:返回两个对象的所有交点 ;参数:  ent1、ent2  均为ename对象 (vl-load-com) (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 )(defun err(msg)    (princ msg)    (setvar "osmode" os)    (setvar "cmdecho" cmd)    (setq *error* errtmp)    (command "_.undo" "e")    (princ) )(defun c:test( / ent1 ent2 entv1 entv2 pts param11 param12 param21 param22 param1 param2 i n2 pt1 pt2)       (setq os (getvar "osmode"))    (setq cmd (getvar "cmdecho"))    (command "_.undo" "be")    (setvar "osmode" 0)    (setvar "cmdecho" 0)    (setq errtmp *error*)    (setq *error* err)    (setq ent1 (car (entsel "\nSelect the first line...")))    (setq ent2 (car (entsel "\nSelect the second line...")))    (if (not n)        (setq n (getint "\n输入密度:"))        (progn (setq n2 (getint (strcat "\n输入密度<" (itoa n) ">:")))            (if n2   (setq n n2)            )        )    )    (setq pts (GetInterpoint ent1 ent2))    (setq entv1 (vlax-ename->vla-object ent1))    (setq entv2 (vlax-ename->vla-object ent2))    (setq param11 (vlax-curve-getParamAtPoint entv1 (car pts)))    (setq param12 (vlax-curve-getParamAtPoint entv1 (cadr pts)))    (setq param21 (vlax-curve-getParamAtPoint entv2 (car pts)))    (setq param22 (vlax-curve-getParamAtPoint entv2 (cadr pts)))    (setq i 1)    (setq param1 (/ (- param12 param11) n))    (setq param2 (/ (- param22 param21) n))    (repeat (1- n)        (setq pt1 (vlax-curve-getPointAtParam ent1 (+ param11 (* param1 i))))        (setq pt2 (vlax-curve-getPointAtParam ent2 (+ param21 (* param2 i))))        (if (= (* (/ i 2) 2) i)            (setq pt2 (list (/ (+ (car pt1) (car pt2)) 2.0)                (/ (+ (cadr pt1) (cadr pt2)) 2.0)                (/ (+ (last pt1) (last pt2)) 2.0)                ))        )        (command "_.line" pt1 pt2 "")        (setq i (1+ i))    )    (setvar "osmode" os)    (setvar "cmdecho" cmd)    (setq *error* errtmp)    (command "_.undo" "e")    (princ) )

wengsg

非常感谢，我真没想到这么快就给了回复。我真心祝愿“明经CAD社区”越办越红火，同时我要把这个好网站介绍给我的亲朋好友。

wengsg

程序很好用，如果能定出短线与长线之间的间距能固定一个参数（如：2.0mm），然后程序自动进行画线，而无需输入密度。


                                                 __|__|__         就是“|”之间的间距固定一个参数

meflying

(if (not n)
(setq n (getint "\n输入密度:"))
(progn (setq n2 (getint (strcat "\n输入密度<" (itoa n) ">:")))
(if n2
(setq n n2)
)
)
)
将以上部分去掉，改为： (setq n 10) 其中，10可以改为适当数字，你可以多改几次以调整。 这种方法是根据两点间的程度进行等分，间距（其实也不能算间距，因为不平行），根据图形大小不同，间距会不同

wengsg

短线能否垂直于①，这样看起来比较美观。

meflying

垂直于1，但在1上不均匀。可以做到在1上均匀，但垂直于2，如果垂直于1又1上均匀，将比较复杂。看是否可以就这样。。。

2. ;函数:GetInterPOint
3. ;功能:返回两个对象的所有交点
4. ;参数:  ent1、ent2  均为ename对象
5. (vl-load-com)
6. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
7.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
8.                ax_ent_2 (vlax-ename->vla-object ent2)
9.    )
10.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
11.    (setq intpoints (vlax-variant-value intpoints))
12.    (setq i 0)
13.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
14.        (repeat (/ (+ 1
15.                            (- (vlax-safearray-get-u-bound intpoints 1)
16.                                  (vlax-safearray-get-l-bound intpoints 1)
17.                            )
18.                      )
19.                      3
20.                )
21.            (setq points (append points (list (list
22.                (vlax-safearray-get-element intpoints i)
23.                (vlax-safearray-get-element intpoints (+ i 1))
24.                (vlax-safearray-get-element intpoints (+ i 2))
25.            )))
26.            )
27.            (setq i (+ 3 i))
28.        )
29.    )
30.    points
31. )(defun err(msg)
32.    (princ msg)
33.    (setvar "osmode" os)
34.    (setvar "cmdecho" cmd)
35.    (setq *error* errtmp)
36.    (command "_.undo" "e")
37.    (princ)
38. )(defun c:test( / ent1 ent2 pts param11 param12 param1 i pt1 pt2)   
39.    (setq os (getvar "osmode"))
40.    (setq cmd (getvar "cmdecho"))
41.    (command "_.undo" "be")
42.    (setvar "osmode" 0)
43.    (setvar "cmdecho" 0)
44.    (setq errtmp *error*)
45.    (setq *error* err)
46.    (setq ent1 (car (entsel "\nSelect the first line...")))
47.    (setq ent2 (car (entsel "\nSelect the second line...")))
48.    (setq n 10)
49.    (setq pts (GetInterpoint ent1 ent2))
50.    (setq param11 (vlax-curve-getParamAtPoint ent2 (car pts)))
51.    (setq param12 (vlax-curve-getParamAtPoint ent2 (cadr pts)))
52.    (setq i 1)
53.    (setq param1 (/ (- param12 param11) n))
54.    (repeat (1- n)
55.        (setq pt2 (vlax-curve-getPointAtParam ent2 (+ param11 (* param1 i))))
56.        (setq pt1 (vlax-curve-getClosestPointTo ent1 pt2))
57.        (if (= (* (/ i 2) 2) i)
58.            (setq pt2 (list (/ (+ (car pt1) (car pt2)) 2.0)
59.                (/ (+ (cadr pt1) (cadr pt2)) 2.0)
60.                (/ (+ (last pt1) (last pt2)) 2.0)
61.                ))
62.        )
63.        (command "_.line" pt1 pt2 "")
64.        (setq i (1+ i))
65.    )
66.    (setvar "osmode" os)
67.    (setvar "cmdecho" cmd)
68.    (setq *error* errtmp)
69.    (command "_.undo" "e")
70.    (princ)
71. )

;函数:GetInterPOint ;功能:返回两个对象的所有交点 ;参数:  ent1、ent2  均为ename对象 (vl-load-com) (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 )(defun err(msg)    (princ msg)    (setvar "osmode" os)    (setvar "cmdecho" cmd)    (setq *error* errtmp)    (command "_.undo" "e")    (princ) )(defun c:test( / ent1 ent2 pts param11 param12 param1 i pt1 pt2)       (setq os (getvar "osmode"))    (setq cmd (getvar "cmdecho"))    (command "_.undo" "be")    (setvar "osmode" 0)    (setvar "cmdecho" 0)    (setq errtmp *error*)    (setq *error* err)    (setq ent1 (car (entsel "\nSelect the first line...")))    (setq ent2 (car (entsel "\nSelect the second line...")))    (setq n 10)    (setq pts (GetInterpoint ent1 ent2))    (setq param11 (vlax-curve-getParamAtPoint ent2 (car pts)))    (setq param12 (vlax-curve-getParamAtPoint ent2 (cadr pts)))    (setq i 1)    (setq param1 (/ (- param12 param11) n))    (repeat (1- n)        (setq pt2 (vlax-curve-getPointAtParam ent2 (+ param11 (* param1 i))))        (setq pt1 (vlax-curve-getClosestPointTo ent1 pt2))        (if (= (* (/ i 2) 2) i)            (setq pt2 (list (/ (+ (car pt1) (car pt2)) 2.0)                (/ (+ (cadr pt1) (cadr pt2)) 2.0)                (/ (+ (last pt1) (last pt2)) 2.0)                ))        )        (command "_.line" pt1 pt2 "")        (setq i (1+ i))    )    (setvar "osmode" os)    (setvar "cmdecho" cmd)    (setq *error* errtmp)    (command "_.undo" "e")    (princ) )

无痕

http://www.xdcad.com/forum/showthread.php?postid=752371#post752371

yfy2003

楼上的怎么看不见啊?

yfy2003

这是测绘用的吧!


自然斜坡的！


最好能按第二条线等分、法线！