lsp二次开发的讨论

闲人

本人现提供一段计算冲截力的原程序，欢迎大家热烈供稿讨论！
(DEFUN ZKA(/ or sa ea ang rc ro x w rc s kk)
(cond ((= name "LINE")
      (setq L (* Z (distance (cdr (assoc 10 ety)) (cdr (assoc 11 ety)))))
      (princ "\n 直线长度?? L = ")
      (princ L)
      )
      ((or (= name "ARC") (= name "CIRCLE"))
      (cond ((= name "ARC")
              (setq sa (cdr (assoc 50 ety)))
              (setq ea (cdr (assoc 51 ety)))
              (setq ang (abs (- ea sa)))
              (if (> ang pi) (setq ang (- (* 2 pi) ang)))
            )
      )
      (setq ro (cdr (assoc 40 ety)))
      (setq x (/ ro t))
      (setq w ro)
      
      (cond ((= name "ARC")
            (setq L (* Z rc ang))
            (princ "\n 圆弧,展开为?? L = ")
            (princ L)
            )
            ((= name "CIRCLE")
            (setq L (* 2 Z pi rc))
            (princ "\n 圆弧,展开为?? L = ")
            (princ L)
            )
      )
      )
      (T (princ "\n 请"))
)
(setq I (+ I 1))
)
;calculat length
(defun CL(/ sa ea ro ang s)
(textscr)
(cond ((= name "LINE")
      (setq L (* Z (distance (cdr (assoc 10 ety)) (cdr (assoc 11 ety)))))
      (princ "\n 直线长度? L = ")

      (princ L)
      )
      ((= name "ARC")
      (setq sa (cdr (assoc 50 ety)))
      (setq ea (cdr (assoc 51 ety)))
      (setq ro (cdr (assoc 40 ety)))
      (setq ang (- ea sa))
      (if (< ang 0 ) (setq ang (- (* 2 pi) (abs ang))))
      (setq L (* ro Z ang))
      (princ "\n 圆弧周长? L = ")
      (princ L)
      )
      ((= name "CIRCLE")
      (setq ro (cdr (assoc 40 ety)))
      (setq L (* 2 Z pi ro))
      (princ "\n 圆周长?? L = ")
      (princ L)
      )
      (T (princ "\n 请"))
)
(setq I (+ I 1))
)
cls
;command
(defun c:ppp(/ c sst n i tl pl l P CCL ety name pa pb pc pd)
(setvar "cmdecho" 0)
(textscr)
(print " 1. 计算周长 " )
(print " 2. ******** " )
(initget (+ 1 2 4))
(setq c (getint "\n  请选择 ( 1 2 ) "))
(setq t (getreal "\n 请输入材料厚度? t = "))
(setq z (getvar "dimlfac"))
(setq sst (ssget '((0 . "line,arc,circle"))))
(setq n (sslength sst))
(setq I 0)
(setq tl 0)
(setq l 0)
(while (< I n)
  (setq ety (entget (ssname sst I)))
  (setq name (cdr (assoc 0 ety)))
  (cond ((= c 1) (CL))
        ((= c 2) (ZKA)))
  (setq TL (+ TL L))
)
(cond ((= c 1) (princ "\n 总长? L = ") (princ TL)
      (setq kk (getreal "\n 请输入材料强度抗剪强度25~35 35~50 50~70? kk = "))
      (SETQ P1 (* 0.0013 kk TL T))
      (SETQ Pt (* 0.0013 0.1 kk TL T))
      
      (princ "\n 冲裁力  P1=")(PRINC P1)(PRINC "(吨)")
      (princ "\n 脱料力  Pt=")(PRINC Pt)(PRINC "(吨)")
        (prin1))
      (princ)
      ))

guizishou

粗略看了看：
(setq t (getreal "\n 请输入材料厚度? t = "))  => t在LISP是关键字，不能用做变量名；下面的都要改
(setq sst (ssget '((0 . "line,arc,circle"))))  => (setq sst (ssget '((0 . "line,arc,circle,lwpolyline"))))