波浪线绘制

King、

                               
登录/注册后可看大图

King、

自己写个半成品，在慢慢写
(defun c:tt ( / )
  (setq mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
        (setq bulge1 0.198912) ;起始点和终点处凸度
        (setq bulge2 0.414214) ;中间点凸度
        (setq len 0.54852814)  ;一个波峰到波谷距离
        (setq h -0.3)          ;深度
  (setq p1 (getpoint "\n请输入起点: "))
  (setq p2 (getpoint p1 "\n请输入终点: "))
  (setq len1 (distance p1 p2));计算起点到终点的长度
  (setq ang (angle p1 p2));计算起点到终点的角度  
  (setq n (fix (/ len1 len)));最大波数
        (setq len2 (* len n));最大波数需要的长度
        (setq len3 (/ (- len1 len2) 2));计算起点偏移长度
        (setq newp1 (polar p1 ang len3));计算起点偏移点坐标
        (setq startpt newp1);起点坐标
        (setq nn n);保存原始n值
  (setq ptlst (list startpt));初始化点列表  
  ;循环生成多段线的中间顶点
        (setq i 1 )
  (while (<= i nn)
                (if (not (zerop (rem i 2))) ;判断是n否为奇数
                        ;奇数
                        (progn
                                (setq p (polar startpt ang (* len i)))
                                (setq p (polar p (+ ang (/ pi 2)) h))
                                (setq ptlst (cons p ptlst))                       
                        )
                        ;偶数
                        (progn
                                (setq p (polar startpt ang (* len i)))
                                (setq ptlst (cons p ptlst))
                        )
                )
                (setq i (1+ i))
        )       
        (setq ptlst (reverse ptlst))
        (Make-LWPOLYLINE ptlst)
)
(defun Make-LWPOLYLINE (lst / PT)
  (entmakeX
                (append
                        (list
                                '(0 . "LWPOLYLINE")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbPolyline")
                                (cons 90 (length lst))
                        )
                        (mapcar '(lambda (pt) (cons 10 pt)) lst)
                )
  )
)

King、

思路应该是错了，在研究研究
(defun c:tt ( / )
  (setq mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
        (setq w 0.54852814);一个波峰到波谷宽度
  (setq h -0.3);波峰到波谷高度
        (setq bulge2 0.414214);中间段凸度
  (setq bulge1 (/ bulge2 2.0));起始段和终点段凸度
  (setq p1 (getpoint "\n请输入起点: "))
  (setq p2 (getpoint p1 "\n请输入终点: "))
  (setq len1 (distance p1 p2));计算起点到终点的长度
  (setq ang (angle p1 p2));计算起点到终点的角度  
  (setq n (fix (/ len1 w)));最大波数
        (setq len2 (* w n));最大波数需要的长度
        (setq len3 (/ (- len1 len2) 2));计算起点偏移长度
        (setq startpt (polar p1 ang len3));计算起点偏移点坐标       
  (setq ptlst (list startpt));初始化点列表  
  ;循环生成多段线的中间顶点
        (setq i 1 )
  (while (<= i n)
                (if (not (zerop (rem i 2))) ;判断是否为奇数
                        ;奇数
                        (progn
                                (setq p (polar startpt ang (* w i)))
                                (setq p (polar p (+ ang (/ pi 2)) h))
                                (setq ptlst (cons p ptlst))
                        )
                        ;偶数
                        (progn
                                (setq p (polar startpt ang (* w i)))
                                (setq ptlst (cons p ptlst))
                        )
                )
                (setq i (1+ i))
        )       
        (setq ptlst (reverse ptlst))
        ;计算每段线中点坐标
        (setq endpt (last ptlst))
        (setq midptlst '())
        (while (cadr ptlst)
                (setq midpt (mapcar '(lambda (x y) (/ (+ x y) 2.)) (car ptlst) (cadr ptlst)))
                (setq midptlst (cons midpt midptlst))
                (setq ptlst (cdr ptlst))
        )
        ;加入终点和起点坐标
        (setq pl_lst (reverse (cons endpt midptlst)))
        (setq pl_lst (cons startpt pl_lst))
        ;创建多段线       
        (setq tmp nil)
        (foreach pt pl_lst
                (setq tmp (append tmp (list (car pt) (cadr pt))))
        )
        (setq pline (vlax-invoke mspace 'AddLightWeightPolyline tmp))
        ;设置凸度
        (setq nn (- (length pl_lst) 1))
        (setq ii 0)
        (while (<= ii nn)
                (cond
                        ;起始段和终点段凸度
                        ((or (= ii 0) (= ii (- nn 1)))
                                (vla-SetBulge pline ii (- bulge1))
                        )
                        ;中间段凸度
                        (t
                                (if (not (zerop (rem ii 2)))
                                        (vla-SetBulge pline ii bulge2);奇数段
                                        (vla-SetBulge pline ii (- bulge2));偶数段
                                )
                        )
                )
                (setq ii (1+ ii))
        )       
)

King、

还是有问题，在研究研究
(defun c:tt ( / )
  (setq mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
        (setq w 0.54852814);一个波峰到波谷宽度
  (setq h -0.3);波峰到波谷高度
  (setq bulge 0.198912);1/8圆凸度
  (setq p1 (getpoint "\n请输入起点: "))
  (setq p2 (getpoint p1 "\n请输入终点: "))
  (setq len1 (distance p1 p2));计算起点到终点的长度
  (setq ang (angle p1 p2));计算起点到终点的角度  
  (setq n (fix (/ len1 w)));最大波数
        (setq len2 (* w n));最大波数需要的长度
        (setq len3 (/ (- len1 len2) 2));计算起点偏移长度
        (setq startpt (polar p1 ang len3));计算起点坐标       
  (setq ptlst (list startpt));初始化点列表  
  ;循环生成多段线的中间顶点
        (setq i 1 )
  (while (<= i n)
                (if (not (zerop (rem i 2))) ;判断是否为奇数
                        ;奇数
                        (progn
                                (setq p (polar startpt ang (* w i)))
                                (setq p (polar p (+ ang (/ pi 2)) h))
                                (setq ptlst (cons p ptlst))
                        )
                        ;偶数
                        (progn
                                (setq p (polar startpt ang (* w i)))
                                (setq ptlst (cons p ptlst))
                        )
                )
                (setq i (1+ i))
        )       
        (setq ptlst (reverse ptlst))
        ;计算每段线中点坐标
        (setq endpt (last ptlst))
        (setq midptlst '())
        (setq tmp_ptlst ptlst)
        (while (cadr tmp_ptlst)
                (setq midpt (mapcar '(lambda (x y) (/ (+ x y) 2.)) (car tmp_ptlst) (cadr tmp_ptlst)))
                (setq midptlst (cons midpt midptlst))
                (setq tmp_ptlst (cdr tmp_ptlst))
        )
        (setq midptlst (reverse midptlst))
        ;点列表：起点、中点1、点1、中点2、点2、...、终点
        (setq pl_lst (list startpt))
        (setq j 0)
        (repeat (length midptlst)
                (setq pl_lst
                        (append pl_lst
                                (list
                                        (nth j midptlst)
                                        (nth (1+ j) ptlst)
                                )
                        )                       
                )
                (setq j (1+ j))
        )
        (setq pl_lst (append pl_lst (list endpt)))
        ;创建多段线       
        (setq tmp nil)
        (foreach pt pl_lst
                (setq tmp (append tmp (list (car pt) (cadr pt))))
        )
        (setq pline (vlax-invoke mspace 'AddLightWeightPolyline tmp))
        ;设置凸度
        (setq nn (- (length pl_lst) 1))
        (setq ii 0)
        (while (< ii nn)
                (cond
                        ((or (= (rem ii 4) 0) (= (rem ii 4) 3))
                                (vla-SetBulge pline ii (- bulge))                               
                        )
                        ((or (= (rem ii 4) 1) (= (rem ii 4) 2))
                                (vla-SetBulge pline ii bulge)                               
                        )
                )
                (setq ii (1+ ii))
        )               
)

King、

知道错误地方，圆弧与圆弧中间还有条线

King、

谁能帮我查下BUG是什么原因，有的时候可以，有的时候倒数第二段线有问题
(defun c:tt3 (/ ang bulge1 bulge2 bxc endpt gh h i j jj k kk len1 len2 len3 mspace n p p1 p2 pline pp pt1 pt2 ptlst1 ptlst2 startpt tmp w)
  (setq mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
        (setq w 0.54852814);一个波峰到波谷宽度
  (setq h 0.3);波峰到波谷高度
        (setq gh 0.08786797);拱高
        (setq bxc 0.21213203);半玄长
        (setq bulge2 0.414214);中间段凸度
  (setq bulge1 (/ bulge2 2.0));起始段和终点段凸度
  (setq p1 (getpoint "\n请输入起点: "))
  (setq p2 (getpoint p1 "\n请输入终点: "))
  (setq len1 (distance p1 p2));计算起点到终点的长度
  (setq ang (angle p1 p2));计算起点到终点的角度  
  (setq n (fix (/ len1 w)));最大波数
        (if (>= n 2)
                (progn
                        (setq len2 (* w n));最大波数需要的长度
                        (setq len3 (/ (- len1 len2) 2));计算起点偏移长度
                        (setq startpt (polar p1 ang len3));起点坐标
                        (setq endpt (polar startpt ang len2));终点坐标
                        (setq ptlst1 (list startpt));初始化点列表  
                        ;循环生成多段线的中间顶点
                        ;起点、波谷圆弧中点、波峰圆弧中点、波谷圆弧中点...终点
                        (setq i 1)
                        (while (<= i (1- n))  
                                (if (not (zerop (rem i 2)))
                                        ;奇数
                                        (progn
                                                (setq p (polar startpt ang (* w i)))
                                                (setq p (polar p (+ ang (/ pi 2)) (- h)))
                                                (setq ptlst1 (cons p ptlst1))
                                        )
                                        ;偶数
                                        (progn
                                                (setq p (polar startpt ang (* w i)))
                                                (setq ptlst1 (cons p ptlst1))
                                        )
                                )
                                (setq i (1+ i))
                        )
                        (setq ptlst1 (cons endpt ptlst1))
                        (setq ptlst1 (reverse ptlst1))       
                        ;循环生成多段线的圆弧顶点
                        ;起点、第一个圆弧终点、波谷圆弧起点、波谷圆弧终点、波峰圆弧起点、波峰圆弧终点...最后一个圆弧起点、终点
                        (setq ptlst2 (list startpt))
                        (setq jj (length ptlst1))
                        (setq j 1)       
                        (while (<= j jj)
                                (setq p (nth (- j 1) ptlst1))
                                (cond
                                        ;起始段
                                        ((= j 1)
                                                (setq pp (polar p (+ ang (/ pi 2)) (- gh)))
                                                (setq pt2 (polar pp ang bxc))
                                                (setq ptlst2 (cons pt2 ptlst2))
                                        )
                                        ;中间段
                                        ((and (> j 1) (< j jj))   
                                                (if (zerop (rem j 2))                                       
                                                        (setq pp (polar p (+ ang (/ pi 2)) gh));偶数点                                       
                                                        (setq pp (polar p (+ ang (/ pi 2)) (- gh)));奇数点                                       
                                                )
                                                (setq pt1 (polar pp ang (- bxc)));圆弧起点
                                                (setq pt2 (polar pp ang bxc));圆弧终点
                                                (setq ptlst2 (cons pt1 ptlst2))
                                                (setq ptlst2 (cons pt2 ptlst2))
                                        )
                                        ;终点段
                                        ((= j jj)
                                                (setq pp (polar p (+ ang (/ pi 2)) (- gh)))
                                                (setq pt1 (polar pp ang (- bxc)))
                                                (setq ptlst2 (cons pt1 ptlst2))
                                                (setq ptlst2 (cons p ptlst2))  
                                        )
                                        (t nil)
                                )
                                (setq j (1+ j))
                        )
                        (setq ptlst2 (reverse ptlst2))
                        ;创建多段线      
                        (setq tmp nil)
                        (foreach pt ptlst2
                                (setq tmp (append tmp (list (car pt) (cadr pt))))
                        )
                        (setq pline (vlax-invoke mspace 'AddLightWeightPolyline tmp))
                        ;设置凸度
                        (setq kk (- (length ptlst2) 1)) ;多段线段数
                        (setq k 0)
                        (while (< k kk)
                                (cond
                                        ;起始段
                                        ( (= k 0)
                                                (vla-SetBulge pline k (- bulge1))
                                        )
                                        ;中间段
                                        ((and (> k 0) (< k (1- kk)))       
                                                ;设置偶数段
                                                (if (zerop (rem k 2))
                                                        ;偶数段交替设置
                                                        (if (zerop (rem (/ k 2) 2))
                                                                (vla-SetBulge pline k (- bulge2));k=2,6,10...
                                                                (vla-SetBulge pline k bulge2);k=4,8,12...
                                                        )
                                                )                               
                                        )
                                        ;终点段
                                        ((= k (1- kk))
                                                (vla-SetBulge pline k (- bulge1))
                                        )
                                        (t nil)
                                )
                                (setq k (1+ k))
                        )
                )
                (princ "\n两点距离不能形成一个完整的波，程序退出")
        )
        (princ)
)

King、

King、 发表于 2025-11-26 18:29
谁能帮我查下BUG是什么原因，有的时候可以，有的时候倒数第二段线有问题
(defun c:tt3 (/ ang bulge1 bulge ...

(and (>= n 2) (= (rem n 2) 0))

King、

King、 发表于 2025-11-26 19:46
(and (>= n 2) (= (rem n 2) 0))

if  n奇数  n-1  更好，对，哈哈

King、

可以了

King、

这样看着舒服些