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

gamexia · 发表于 2018-10-26 14:39:53

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

lisperado · 发表于 2018-10-28 21:03:58

本帖最后由 lisperado 于 2018-10-29 14:10 编辑

谢谢l顶上

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

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

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

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

;; 举例： 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 · 发表于 2018-10-30 18:17:09

(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 · 发表于 2018-10-30 01:58:31

本帖最后由 lisperado 于 2018-10-30 02:12 编辑

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

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

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

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

lisperado · 发表于 2018-10-28 01:53:39

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

[/img]

13648893846 · 发表于 2018-10-28 06:20:03

顶出源码学习

yoyoho · 发表于 2018-10-28 14:52:56

顶出源码学习!!!!!

gamexia · 发表于 2018-10-28 21:57:27

感谢帮助，感谢提供源码

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

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

lisperado · 发表于 2018-10-29 00:13:53

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

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

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

yoyoho · 发表于 2018-10-29 08:11:58

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

20060510412 · 发表于 2018-10-29 08:46:11

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

gamexia · 发表于 2018-10-29 09:28:29

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

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

账号		自动登录	找回密码
密码			注册

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

本帖子中包含更多资源

评分

点评

本帖子中包含更多资源