哪位大侠愿意帮小第写一个LISP程序吗？（关于模具的）

前生

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ca (/ dot dq)                        ; start view1)
;;;____________________________________________
  (defun setlay        (lay cor lty / ACDOC LAYS VVLAY)
                                        ;lay:字串;cor:颜值;LTY:型
    (setq acDoc        (vla-get-ActiveDocument (vlax-get-acad-object))
          lays        (vla-get-Layers acDoc)
    )
    (if        (null (tblobjname "LAYER" lay))
      (progn
        (if (/= "CONTINUOUS" LTY)
          (progn
            (if        (null (entlast))
              (progn
                (command "circle" "0,0" "0.5")
                (COMMAND "CHANGE" (ENTLAST) "" "" "LT" LTY "")
                (entdel (Entlast))
              )
              (COMMAND "CHANGE" (ENTLAST) "" "" "LT" LTY "")
            )
          )
        )
        (entmake (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   (cons 6 lty)
                   (cons 62 cor)
                   '(70 . 0)
                   (cons 2 lay)
                 )
        )
        (setvar "clayer" lay)
      )
      (progn                                ;已存在
        (setq vvlay (vla-Item lays lay))
        (if (= (vla-get-Freeze vvlay) :vlax-true)
          (vla-put-Freeze vvlay :vlax-false) ;解冻
        )
        (if (= (vla-get-Lock vvlay) :vlax-true)
          (vla-put-Lock vvlay :vlax-false) ;解锁
        )
        (if (= (vla-get-LayerOn vvlay) :vlax-false)
          (vla-put-LayerOn vvlay :vlax-true) ;可见
        )
        (vla-put-ActiveLayer acDoc vvlay) ;设为当前层
      )
    )
  )
;;;____________________________________________
(defun        ourscg ()
   (setq count 0)
   (setq emax (sslength sec))
   (while (< count emax)
     (setq EN (ssname sec COUNT)
           ED (ENTGET EN)
     )
     (SETQ ED (SUBST (CONS 8 wj) (assoc 8 ed) ED))
                                        ;(SETQ ED (SUBST (CONS 8 "1") (assoc 8 ed) ED))
     (ENTMOD ed)
     (SETQ COUNT (1+ COUNT))
   )                                        ;WHILE
   (Setq count nil)
)                                        ;FIRST OF PROGN
;;;____________________________________________
  (defun se ()
    (setq sec (ssget (list (cons 0 "CIRCLE"))))
    (if        sec
      (setq kg1 0)
      (setq kg1 1)
    )
  )
;;;____________________________________________
  (setq dot 4)
  (setlay "ph" 4 "CONTINUOUS")
  (setlay "ps" 1 "CONTINUOUS")
  (setlay "die" 7 "CONTINUOUS")
  (SETQ wj "ph")
  (setq kg1 1)
  (SETQ Dq (LOAD_DIALOG "spring.DCL"))
  (while (> dot 1)
    (if        (new_dialog "spring" dq)
      (progn
        (mode_tile "accept" kg1)
        (foreach d '("ph" "ps" "die")
          (action_tile d "(setq wj $key)")
        )
        (set_tile wj "1")
        (action_tile "se" "(done_dialog 3)")
        (action_tile "view1" "(done_dialog 2)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq dot (start_dialog))
        (cond
          ((= 1 dot) (ourscg))
          ((= 3 dot) (se))
          ((= 2 dot)
           (PROGN
             (while (getpoint "\n  回车或空格退出:.."))
           )
          )
        )
      )
    )
  )
  (setq ss2 nil)
  (unload_dialog dq)
  (princ)
)

;;;;;;;;;;;;;;;;;;;;;
;;;sprinc.dcl
spring:dialog{label = "异形零件绘制";
:row{
:radio_column{label="选择项";
   :radio_button {label = "【上固定板】";key = "ph";}
   :radio_button {label = "【上卸料板】";key = "ps";}
   :radio_button {label = "【下 模 板】";key = "die";}
     }
:boxed_column{fixed_width=true;
       :button{label="选取实体";key="se";fixed_width= true;width= 8;alignment = centered;}
       :button{label="CAD预览";width=5;fixed_width = true;key="view1";alignment=centered;}
       }
       }
   ok_cancel;
    }

spring

spring

前生

spring

spring

前生

改写一下就好了，自己试试改一下

spring