有没有在圆弧或者多段线上画三角齿

吴外安放

有没有在圆弧或者多段线上画三角齿从起点开始，到尾位不够了结束原版作者：gaisc 只能画直线(defun c:saw (/ pt1 pt2 pt ang len n lst Model obj)
  (setvar "cmdecho" 0)
;;;;画尖角锯齿线子函数
  (defun sawtooth1 ()
    (setq pt2 (getpoint pt1 "\n输入终点："))
    (setq ang (angle pt1 pt2))
    (setq len (distance pt1 pt2))
    (setq pt (mapcar '- pt1 pt2))
    (if        (> (car pt) 0)
      (setq pub_w (* pub_w -1)
            ang        (- ang pi)
      )
    )
    (setq pt (mapcar '+ pt1 '(0 0)))
    (setq lst (cons pt lst))
    (setq n (fix (/ len (abs pub_w))))
    (repeat n
      (setq pt (mapcar '+ pt (list (* pub_w 0.5) pub_d)))
      (setq lst (cons pt lst))
      (setq pt (mapcar '+ pt (list (* pub_w 0.5) (* pub_d -1))))
      (setq lst (cons pt lst))
    )
    (setq lst (reverse lst))
    (setq obj (ptlst2pline lst))
    (vla-Rotate obj (vlax-3D-point pt1) ang)
  )
;;;;画圆弧角锯齿线子函数
  (defun sawtooth2 ()
    (setq pt2 (getpoint pt1 "\n输入终点："))
    (setq len (distance pt1 pt2))
    (setq ang (angle pt1 pt2))
    (setq h (xPT))
    (setq pt (mapcar '- pt1 pt2))
    (if        (> (car pt) 0)
      (setq pub_w (* pub_w -1)
            ang        (- ang pi)
      )
    )
    (setq pt (mapcar '+ pt1 '(0 0)))
    (setq lst (cons pt lst))
    (setq pt (mapcar '+ pt (list (* pub_w 0.25) (* h -1))))
    (setq lst (cons pt lst))
    (setq n (fix (/ len (abs pub_w))))
    (repeat n
      (setq pt (mapcar '+ pt (list (* pub_w 0.5) (* h 2))))
      (setq lst (cons pt lst))
      (setq pt (mapcar '+ pt (list (* pub_w 0.5) (* h -2))))
      (setq lst (cons pt lst))
    )
    (setq pt (mapcar '+ pt (list (* pub_w 0.25) (* h 1))))
    (setq lst (cons pt lst))
    (setq lst (reverse lst))
    (setq obj (ptlst2pline lst))
    (setvar "FILLETRAD" pub_r)
    (command ".FILLET" "P" (vlax-vla-object->ename obj))
    (vla-Rotate obj (vlax-3D-point pt1) ang)
  )
;;;;主函数
  (if (or (null pub_w) (= pub_w 0))
    (setq pub_w 3.0)
    (setq pub_w (abs pub_w))
  )
  (if (or (null pub_d) (= pub_d 0))
    (setq pub_d 2.0)
    (setq pub_d (abs pub_d))
  )
  (if (null pub_r)
    (setq pub_r 0.0)
    (setq pub_r (abs pub_r))
  )
  (while (not (equal (type pt1) 'list))
    (princ (strcat "\n>>>>当前设置[锯齿间距:"
                   (rtos pub_w 2 2)
                   "mm, 锯齿高度:"
                   (rtos pub_d 2 2)
                   "mm, 齿尖半径:"
                   (rtos pub_r 2 2)
                   "mm]"
           )
    )
    (initget 128 "W D R")
    (setq pt1 (getpoint"\n输入起点或输入选项 [间距(W)/高度(D)/半径(R)]:"))
    (cond
      ((= pt1 "W")
       (if (not (setq pub_w (getreal "\n输入锯齿间距w[3.0mm]：")))
         (setq pub_w 3.0)
       )
      )
      ((= pt1 "D")
       (if (not (setq pub_d (getreal "\n输入锯齿高度d[2.0mm]：")))
         (setq pub_d 2.0)
       )
      )
      ((= pt1 "R")
        (setq pub_r nil)
        (while (null pub_r)
          (if (not
                (setq pub_r (getreal "\n输入牙尖半径r[0.0mm]："))
              )
            (setq pub_r 0.0)
          )
          (if (>= pub_r (* pub_w 0.25))
            (progn (princ "**r必须小于w/4**") (setq pub_r nil))
          )
        )
      )
      ((equal (type pt1) 'list)
       (if (= pub_r 0)
         (sawtooth1)
         (sawtooth2)
       )
      )
    )
  )
  (princ)
)
;;;计算尖点高度
(defun xPT (/ l a b c h)
  (setq l (expt (+ (expt (- pub_d (* pub_r 2)) 2) (expt (/ pub_w 2) 2)) 0.5))
  (setq a (Arcsin (/ pub_r (* l 0.5))))
  (setq b (Arccos (/ (* pub_w 0.5) l)))
  (setq c (+ a b))
  (setq h (* (/ (sin c) (cos c)) (* pub_w 0.25)))
)
(defun Arcsin (x)
  (Atan (/ x (expt (- 1.0 (* x x)) 0.5)))
)
(defun Arccos (x)
  (atan (/ (sqrt (- 1.0 (* x x))) x))
)
;;;二维点表生成多段线
(defun ptlst2pline (lst / Model)
  (setq lst (apply 'append lst))
  (setq        Model (vla-get-ModelSpace
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
  )
  (vla-AddLightWeightPolyline
    Model
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray
          vlax-vbdouble
          (cons 1 (length lst))
        )
        lst
      )
    )
  )
)

吴外安放

顶一下看有没有大神