绘制波浪线

brige2009

求教高手编写一个绘制两点波浪线的lisp程序，主要用于绘制局部剖视图分界线。多谢！

命令:curve，命令的功能为绘制两点波浪线，用于局部剖视图分界线。

1、请选择第一点: 鼠标选择或者输入坐标，可以使用对象捕捉

2、请选择第二点: 鼠标选择或者输入坐标，可以使用对象捕捉

所用图层为波浪线03层，颜色为绿色。

效果图如下。

caoyin

;;; WAVES.lsp
;;; by caoyin @ 2011.08.04
;;; 绘制波浪线
;;; -----------------------------------------------------------------
;;; 主要代码其实十分钟就可以写出来了，为了让程序稍微“好看”一点，花了
;;; 一个钟头的时间，希望能给新手带来一些启示……
(defun C:WAVES (/ R2S P1 PA BU TAG P2 ANG LST I OBJ BU)
  (defun R2S (REL / DZIN)
    (setq DZIN (getvar "DIMZIN"))
    (setvar "DIMZIN" 0)
    (setq REL (rtos REL 2 (getvar "LUPREC")))
    (setvar "DIMZIN" DZIN)
    REL
  )
  (if (setq P1 (getpoint "\n指定起点: "))
    (progn
      (or *WAVES-PA* (setq *WAVES-PA* 100.0))
      (or *WAVES-BU* (setq *WAVES-BU* 0.5))
      (setq TAG T PA *WAVES-PA* BU *WAVES-BU*)
      (while (or TAG (not (vl-consp P2)))
        (mapcar
          'princ
          (list "\n当前设置: 段长 = " (R2S *WAVES-PA*) "，凸度 = " (R2S *WAVES-BU*))
        )
        (initget "Set")
        (setq P2 (getpoint P1 "\n指定终点或 [设置(S)]: "))
        (cond
          ((= P2 "Set")
           (or (setq PA (getdist (strcat "\n指定段长 <" (R2S *WAVES-PA*) ">: ")))
               (setq PA *WAVES-PA*)
           )
           (while (and (setq BU (getdist (strcat "\n指定凸度 <" (R2S *WAVES-BU*) ">: ")))
                       (or (< BU 0) (> BU 1.5))
                       (princ "\n凸度应为0~1.5之间的数字。")
                  )
           )
           (or BU (setq BU *WAVES-BU*))
          )
          ((vl-consp P2)
           (if (> (setq DI (distance P1 P2)) PA)
             (setq TAG nil)
             (mapcar 'princ (list "\n两点之间距离" (R2S DI) " 不能小于段长 " (R2S PA) "。"))
           )
          )
        )
      )
      (setq P1  (list (car P1) (cadr P1))
            P2  (list (car P2) (cadr P2))
            ANG (angle P1 P2)
            LST P1
            I   (fix (/ DI PA))
      )
      (repeat I
        (setq P1  (polar P1 ANG PA)
              LST (append LST P1)
        )
      )
      (setq OBJ (vla-AddLightweightPolyline
                    (vlax-get
                      (vla-get-ActiveDocument (vlax-get-acad-object))
                      (if (= (getvar 'TILEMODE) 1)
                        'ModelSpace
                        'PaperSpace
                      )
                    )
                    (vlax-make-variant
                      (vlax-safearray-fill
                        (vlax-make-safearray
                          5
                          (cons 0 (1- (length LST)))
                        )
                        LST
                      )
                    )
                  )
      )
      (setq *WAVES-PA* PA *WAVES-BU* BU)
      (repeat (setq I (/ (length LST) 2))
        (vla-SetBulge OBJ (setq I (1- I)) (setq BU (- BU)))
      )
;|
红色注释部分代码为楼主添加，不需要可以删掉
     (setq DOC  (vla-get-ActiveDocument (vlax-get-acad-object))
              LAYS (vla-get-layers DOC))
        (if (vl-catch-all-error-p (setq LAY (vl-catch-all-apply 'vla-item (list LAYS "波浪线
03"))))
          (vla-add LAYS "波浪线03")
        )
        (vla-put-layer OBJ "波浪线03")
        (vla-put-color OBJ 3)
|;
    )
  )
  (princ)
)

yoyoho

感谢caoyin版主分享程序,下载收藏学习了!

raimo

caoyin 版主能不能帮忙弄下这个啊..同样是曲线..但是更有难度一些..ZZXXQQ版有发一个但是不稳定,用过几次就经常画不出来了
http://bbs.mjtd.com/thread-87250-1-1.html

brige2009

非常感谢版主的敬业很分享的精神，这么快就有了答复，很感动

caoyin

回复 raimo 的帖子

难度在哪？我大部分都写出来了，自己加个箭头应当不难吧

raimo

回复 caoyin 的帖子

我觉得挺难的,一定要按照附件里面的那种来绘制
第一:曲线不同,是由两段弧形构成的,并且弧度超过180度
第二:转弯部分的弧线连接方式
第三:箭头的起始长度与弧线的连接都有举例文件里那样的要求