求助！！两条非等距离的样条曲线之间如何绘制几条等分的曲线

gamexia

求助！！两条非等距离的样条曲线之间，如何绘制几条等分的曲线
            如图：黑线与红线之间插入蓝色等分的曲线，不一定是插入2条，是指定条数
           如何实现？

lisperado

谢谢l顶上
但不见原版主回复所以只提供函数 ，其他用法只需自行更改参数吧！

简单思路只提供参考，原因函数返回表值并不代表曲线弯孤度所以并不精准！尤其弯度角度太大请避免！！

1. ;|
   
2. --------------- vlax-curve-DivideBetweenPair ---------------
   
3.                                                             
   
4.   Returns a approximate point list between two cross-section
   
5.   curves by a dividing parameter, concept of LOFT command
   
6. ------------------------------------------------------------
   
7.   Author: lisperado     
   
8. ------------------------------------------------------------
   
9. 
   
10.   Arguments:
    
11.   e1,e2        - Curve entities/objects SPLINE,LWPOLYLINE etc..
    
12.   x         - Direction mode 0 or 1, integer               
    
13.   y         - Divide parameter, integer
    
14.   
    
15. ------------------------------------------------------------
    
16.   Returns:  list of Point list (WCS)   
    
17. ------------------------------------------------------------|;
    
18. 
    
19. ;;Note: NOT accurate for sharp curve
    
20. 
    
21. (defun vlax-curve-DivideBetweenPair ( e1 e2 y /  m i d  p o l a r   )
    
22. 
    
23.   (setq        i 32.0  ;;;纵向密度用户自行设定  
    
24.         a (list e1 e2)
    
25.         )
    
26. 
    
27.   (foreach e a
    
28.     (setq r nil
    
29.           d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
    
30.           m (/ d i)
    
31.           l 0.0
    
32.           )
    
33.     (while (and (< l d) (setq p (vlax-curve-getpointatdist e l)))
    
34.       (setq l (+ l m)
    
35.             r (cons p r)
    
36.             )
    
37.       )
    
38.     (setq o (cons (reverse r) o))
    
39.     ) ; foreach
    
40. 
    
41.   (setq        r nil
    
42.         p '((x) (mapcar '* '(1. 1. 0.) x)) ; 转换2D
    
43.         o (mapcar '(lambda (a b) (append a (list (vlax-curve-getendpoint b)))) o (reverse a))
    
44.         )
    
45. 
    
46.   (foreach x (apply 'mapcar (cons '(lambda (a b) (list (setq b (p b) a (p a) ) (angle a b) (/ (distance a b) y))) o))
    
47.     (setq
    
48.           l nil
    
49.           p (car x)
    
50.           )
    
51.     (repeat (1- y)
    
52.       (setq
    
53.             p (apply 'polar (cons p (cdr x)))
    
54.             l (cons p l)
    
55.             )
    
56.       ) ; repeat
    
57.     (setq r (cons l r))
    
58.     ) ; foreach
    
59.   (apply 'mapcar (cons 'list r))
    
60.   )
    
61. 
    

;|<br /> --------------- vlax-curve-DivideBetweenPair ---------------<br />                                                             <br />   Returns a approximate point list between two cross-section<br />   curves by a dividing parameter, concept of LOFT command<br /> ------------------------------------------------------------<br />   Author: lisperado     <br /> ------------------------------------------------------------<br /> <br />   Arguments:<br />   e1,e2        - Curve entities/objects SPLINE,LWPOLYLINE etc..<br />   x         - Direction mode 0 or 1, integer                <br />   y         - Divide parameter, integer<br />   <br /> ------------------------------------------------------------<br />   Returns:  list of Point list (WCS)   <br /> ------------------------------------------------------------|;<br /> <br /> ;;Note: NOT accurate for sharp curve <br /> <br /> (defun vlax-curve-DivideBetweenPair ( e1 e2 y /  m i d  p o l a r   )<br /> <br />   (setq        i 32.0  ;;;纵向密度用户自行设定  <br />         a (list e1 e2)<br />         )<br /> <br />   (foreach e a<br />     (setq r nil<br />           d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))<br />           m (/ d i)<br />           l 0.0<br />           )<br />     (while (and (< l d) (setq p (vlax-curve-getpointatdist e l)))<br />       (setq l (+ l m)<br />             r (cons p r)<br />             )<br />       )<br />     (setq o (cons (reverse r) o))<br />     ) ; foreach<br /> <br />   (setq        r nil<br />         p '((x) (mapcar '* '(1. 1. 0.) x)) ; 转换2D <br />         o (mapcar '(lambda (a b) (append a (list (vlax-curve-getendpoint b)))) o (reverse a))<br />         )<br /> <br />   (foreach x (apply 'mapcar (cons '(lambda (a b) (list (setq b (p b) a (p a) ) (angle a b) (/ (distance a b) y))) o))<br />     (setq <br />           l nil<br />           p (car x)<br />           )<br />     (repeat (1- y)<br />       (setq <br />             p (apply 'polar (cons p (cdr x)))<br />             l (cons p l)<br />             )<br />       ) ; repeat<br />     (setq r (cons l r))<br />     ) ; foreach<br />   (apply 'mapcar (cons 'list r))<br />   )<br /> <br />

;; 举例 ： e1  & e2 各是曲线，平份于 5
( vlax-curve-DivideBetweenPair e1 e2 5 )
;; 返回表：
;(((113.88 294.633 0.0) (98.7727 293.563 0.0) (83.6605 292.562 0.0) (68.539 291.699 0.0) ....

;;编辑： 1. 更正: 移除多余变量 setq i 0 & setq i 1+ i
2. 暂时只支持2D因为polar函数距离参数以平面为基础

yoyoho

(defun c:tt ( / e1 e2 y ) ;自定义lisp命令=tt , e1 e2 y 局部化避免变量冲突

  (if
    (and (setq e1 (car (entsel "\n选取第一条曲线 "))) ; 储存于变量e1
           (setq e2 (car (entsel "\n选取第二条曲线 "))) ; 储存于变量e2
           (setq y (cond  ((getint "\nDivide by # ? ")) (5))) ;平分默认值=5
           ) ; 储存于变量 y

    (foreach x (vlax-curve-DivideBetweenPair e1 e2 y) ; 把各自有效变量使用于函数参数，返回值=坐标表

;画线需要开始&终点
;利用cdr分成两个序列表 A B C D ...
;(A B C D) 陪对 (B C D) ...

;以mapcar迭代表值以用于绘画功能
;A-B,B-C,C-D etc.. 符合线型表达
      ;(mapcar ''((a b) (grdraw a b 1)) x (cdr x)) ；以grdraw函数瞬态绘画A-B,B-C,C-D....
      (Entmake-Spline x)
      )
    (princ "\n退出？") ;如果选取无效退出
    )
  (princ) ; 无痕迹退出
)

(defun Entmake-Spline (ptn / a)
  (entmake (append (list '(0 . "SPLINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbSpline")
                         '(71 . 3)
                   )
                   (mapcar '(lambda (pt) (cons 11 pt)) ptn)
           )
  )
  (entlast)
)

lisperado

20060510412 发表于 2018-10-29 19:24
个人感觉貌似还有几点可以改进一下：
1.生成的是直线，改为多段线是否更方便选取。
2.对于边界为直线的 ...

当然可行只是故意让你自己从思路中学习如何优化...

以下思路， 请自行明经社区里搜索应该会好多画多段线函数
1.无需代码：先选取程序所画的线（或过滤其图层）以命令: _PEDIT JOIN 可解决！
2.命令方式 ： PLINE
3.entmake方式 ： LWPOLYLINE
4.activeX方式：vla-AddLightWeightPolyline
推荐方法之3以参考 , 其它自行搜索&研究
在这里是以 'x' 变量表达

1. (foreach x (vlax-curve-DivideBetweenPair e1 e2 y)
   
2. ;;;      (mapcar ''((a b) (grdraw a b 1) ) x (cdr x))
   
3.          (entmakex (vl-list* '(0 . "LWPOLYLINE")
   
4.                             '(100 . "AcDbEntity")
   
5.                             '(100 . "AcDbPolyline")
   
6.                             '(62 . 1)
   
7.                             (cons 70 0)
   
8.                             (cons 90 (length x))
   
9.                             (mapcar '(lambda (x) (cons 10 x) ) x)
   
10.                             )
    
11.                   )
    
12. 
    
13.       )

(foreach x (vlax-curve-DivideBetweenPair e1 e2 y)<br /> ;;;      (mapcar ''((a b) (grdraw a b 1) ) x (cdr x))<br />          (entmakex (vl-list* '(0 . "LWPOLYLINE")<br />                             '(100 . "AcDbEntity")<br />                             '(100 . "AcDbPolyline")<br />                             '(62 . 1)<br />                             (cons 70 0)<br />                             (cons 90 (length x))<br />                             (mapcar '(lambda (x) (cons 10 x) ) x)<br />                             )<br />                   )<br /> <br />       )

lisperado

试试上传图片
[img]%5Bimg%5D[/img]

13648893846

顶出源码学习

yoyoho

顶出源码学习!!!!!

gamexia

感谢帮助，感谢提供源码

不知道为何，我看不到图片，所以没有及时回复，

我看到的是一直图片如下：

lisperado

gamexia 发表于 2018-10-28 21:57
感谢帮助，感谢提供源码

不知道为何，我看不到图片，所以没有及时回复，

起初我用手机版也看不见，之后试电脑版打开网页才可见。
请看明经页面最下方项选

yoyoho

谢谢! lisperado 分享程序!!!!!

20060510412

lisp菜鸟，只给函数源码，还是不会使用......

gamexia

lisperado 发表于 2018-10-28 21:03
谢谢l顶上
但不见原版主回复所以只提供函数 ，其他用法只需自行更改参数吧！

感谢提供函数，完整的lisp也分享一下吧，