[编程交流] Lisp赢得#039；t运行

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:ESS (/ SIZE$ SIZE PT01 PT02 a b lw)
 (ESS_SAVE)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Save User Settings Function.
;
(defun ESS_SAVE (/ SUS)
 (setq SUS_LIST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "angbase" "angdir" "cecolor"))
 (setq TERR$ *error*)
 (setq *error* ESS_ETRAP)
 (ESS_MF)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun ESS_MF ()
 (or S:SIZE (setq S:IZE 0))
 (setq S1_list '( "1500mm"  "1350mm" "1200mm" "1050mm" "900mm" "750mm" "675mm" "600mm" "525mm" "450mm" "375mm" "300mm" "225mm" "150mm"))
 (setq dcl_id (load_dialog "ESS.dcl"))
 (if (not (new_dialog "ESS" dcl_id))
   (progn (ALERT "Can not find your dcl file")
     (exit)))
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if SIZE:DEF (set_tile "S1" (itoa SIZE:DEF)))
 (action_tile "cancel" "(done_dialog)(setq userclick nil)(ESS_RESTORE)")
 (action_tile "accept"
   (strcat
    "(progn
     (setq S:IZE (atoi (get_tile "S1")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"))
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (ESS_VARIABLE))
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; ESS_VARIABLE Function
;
(defun ESS_VARIABLE ()
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$ "1500mm")(setq SIZE$ "1500"))
     ((= SIZE$ "1350mm")(setq SIZE$ "1350"))
     ((= SIZE$ "1200mm")(setq SIZE$ "1200"))
     ((= SIZE$ "1050mm")(setq SIZE$ "1050"))
     ((= SIZE$  "900mm")(setq SIZE$  "900"))
     ((= SIZE$  "750mm")(setq SIZE$  "750"))
     ((= SIZE$  "675mm")(setq SIZE$  "675"))
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))))
 (setq SIZE SIZE$) 
 (ESS_OUTPUT)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; ESS_OUTPUT Function
;
(defun ESS_OUTPUT ()
 (if (null (tblsearch "STYLE" "CCC_Services"))
   (entmake
     (list
       (cons 0 "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2 "CCC_Services")
       (cons 3 "Verdana.ttf")
       (cons 40 0)
       (cons 70 0))))
 (setq a  (strcat "CCC_DR_"SIZE)
       b  (strcat "CCC_SERVICES_EXISTING_Drainage_Storm_Sewer_Concrete_"SIZE)
       lw 30)
 (if (null (tblsearch "LTYPE" a))
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" ""))
 (if (null (tblsearch "LAYER" b))
 (command "_.-layer" "_N" b "_M" b "_L" a b "_C" "84" b "_LW" "0.3" b "" ))
 (command "_-color"  "bylayer")
 (command "._-linetype"  "s"  "bylayer" "")    
 (setvar "cmdecho" 0)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (command "_.-layer" "_S" b "")
 (setvar "plinegen" 1)
 (command "._pline")
 (ESS_RESTORE)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun ESS_DTR (DEGREES)
(* pi (/ DEGREES 180.0)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun ESS_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Restore User Settings Function.
;
(defun ESS_RESTORE ()
 (setq *error* TERR$)
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nProgram completed and will now restore the user settings and exit.")
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Error Trap Function.
;
(defun ESS_ETRAP (ERRORMSG)
 (command nil nil nil)
 (if (not (member ERRORMSG '("console break" "Function cancelled")))
   (princ (strcat "\nError:" ERRORMSG)))
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nAn *error* has occured!")
 (princ "\nThe program will now restore the user settings and exit.")
 (terpri)
 (setq *error* TERR$)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////