;;; 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 'CVPORT) 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)))
      )
    )
  )
  (princ)
)