[推荐]：上传一个虾米弯绘制lisp，希望大家喜欢！

liqilin7288

在指定的图层上，绘制90度虾米弯lisp程序，没有多少钱，只能出此下策。

nosingle

楼主不是太厚道啊，咳，不下了.

xyp1964

有错误，居然还收币！！
[php]
                                        ;   虾米弯
                                        ;
(defun c:xm (/          x    x0   y         a1   a2   p0        p1x  p2x  p3x  p4x
             p5x  p6x  p7x  p8x         p9x  p10x p1y        p2y  p3y  p4y  p5y
             p6y  p7y  p8y  p9y         p10y q0   ss        e    na          b    d1
             d2          jd
            )
  (if (not (and xmr xmd))
    (setq _xmr 750.
          _xmd 500.
    )
  )
  (setq x (getdist (strcat "\n虾米弯中心半径 <" (rtos xmr 2 0) ">: ")))
  (progn
    (setq _xmr (if x
                 x
                 xmr
               )
          x    (getdist (strcat "\n虾米弯直径 <" (rtos xmd 2 0) ">: "))
          xmd  (if x
                 x
                 xmd
               )
    )
    (if        (setq p0 (getpoint "\n虾米弯中心位置 <退出>: "))
      (progn
        (setq d1 (+ xmr (/ xmd 2))
              d2 (- xmr (/ xmd 2))
              jd (/ (* 15 pi) 180)
              jd1 (/ (* 45 pi) 180)
              p1x (+ xmr (/ xmd 2))
              p1y 0
              p2x (+ xmr (/ xmd 2))
              p2y (* (+ xmr (/ xmd 2)) (/ (sin jd) (cos jd)))
              p3x (- p2x
                     (*        (+ xmr (/ xmd 2))
                        2
                        (* (/ (sin jd) (cos jd)))
                        (cos jd2)
                     )
                  )
              p3y (+ p2y
                     (*        (+ xmr (/ xmd 2))
                        2
                        (* (/ (sin jd) (cos jd)))
                        (cos jd2)
                     )
                  )
              p4x (* (+ xmr (/ xmd 2)) (/ (sin jd) (cos jd)))
              p4y (+ xmr (/ xmd 2))
              p5x 0
              p5y (+ xmr (/ xmd 2))
              p1 (mapcar '- p0 (list p1x p1y))
              p2 (mapcar '- p0 (list p2x p2y))
              p3 (mapcar '- p0 (list p3x p3y))
              p4 (mapcar '- p0 (list p4x p4y))
              p5 (mapcar '- p0 (list p5x p5y))
              (mlayer "外轮廓层" "4" "continuous");提示错误 : bad variable name in SETQ: (MLAYER "外轮廓层" "4" "continuous")
               (command ".pline" p1 p2 p3 p4 p5 "c")
              (mlayer "中心线层" "1" "center2");提示错误:
               (command ".line" p5 p6 "")
              (command ".line" p7 p8 "")
        )
        ;;(command ".pline" p1 q0 p3 ""))
        (mlayer "外轮廓层" "4" "continuous");未定义mlayer函数
        (princ)
      )
    )
  )
)[/php]