[下载]：lisp程序

crtrccrt

;;; Protected by Convert 7.2, Reg.nr:
;;; DDCLS.LSP     Creates/sets CLS layers via dialog.
(DEFUN C:DDCLS (/ DEMO LIST_NAME SHOW_G SHOW_L L_SORT DO_GROUP DO_LIST DO_LIST2
                  OOPS OOPS2 ADD_LAYER DO_ADD DO_DEL GET_LAY TEST_IT maincls
                  ddcls_reg do_reg CLSDEMO CHFLAG CLAY GUMBY old_err LAYN DO_EDIT
                  EDIT_LAYER AA ADD BB CC CNT DCL_ID DO_ADD FL FLA FLB FLE MOD1
                  GLIST GN GNC GNL GNN GNX LAYC LAYLT LAYP LAYT LCOLOR LDESC
                  LLIST LLTYPE LLTYPEL LNAME LNAMEL LOK LST MOD2 PRINTIT SER
                  SERCNF SERCNT SERDGT X XXA XXX YYY Z CDATE DDCLS_DEMO_FLG CCD
                  DOADD DT LINELEN NEXTLINE SERFILE SERFILEL SPACES REG_OK FLG
               )
  (setq old_err *error*)
  (defun *error* (msg)
    (princ "error: ")
    (princ msg)
    (setq *error* old_err)
    (term_dialog)
    (princ)
  )
  (defun LIST_NAME (/ FLY FLZ)
    (cond
      ((= gn "equi") (setq flg "Q"))
      ((= gn "othe") (setq flg "X"))
      ((= gn "cont") (setq flg "Z"))
      (T
        (setq flg (strcase (substr gn 1 1)))
      )
    )
    (setq fla (atoi fl)
          fly (nth fla GLIST)
          flz (substr fly 1 15))
    (if (= flz "Lightning Prote")
      (setq flz "Ltng")
    )
    (setq fla (strcase (substr flz 1 4))
          fle (strcat DDCLSDIR "LAYERS\\" flg "-" fla ".LYR"))
    (setq flb (strcat DDCLSDIR "LAYERS\\" flg "-" fla ".BKK"))
    (if LAYN
      (set_tile "error" (strcat "DISCIPLINE: " gnn "    GROUP: " (SUBSTR fly 1 26)
                              "    LAYER: " LAYN
                        )
      )
      (set_tile "error" (strcat "DISCIPLINE: " gnn "    GROUP: " (SUBSTR fly 1 26)))
    )
  )                                  ;end LIST_NAME
  (defun chg_error ()
    (setq flg (strcase (substr gn 1 1))
          fla (atoi fl)
          fly (nth fla GLIST)
          flz (substr fly 1 15))
    (if (= flz "Lightning Prote")
      (setq flz "Ltng")
    )                                ;  (if (= flz "Floor Plan Info") (setq flz-
                                     ; "Plan"))
    (if LAYN
      (set_tile "error" (strcat "DISCIPLINE: " gnn " + \"" DISC2 "\"    GROUP: "
                                (SUBSTR fly 1 26) "    LAYER: " LAYN
                        )
      )
      (set_tile "error" (strcat "DISCIPLINE: " gnn " + \"" DISC2 "\"    GROUP: "
                                (SUBSTR fly 1 26)
                        )
      )
    )
  )
  (defun SHOW_G (/ ADD ADDLIST GRP)
    (mode_tile gn 2)
    (setq grp (strcat DDCLSDIR "GROUPS/" gn ".grp"))
    (setq lst (open grp "r"))
    (setq GLIST (list (read-line lst))
          add (read-line lst)
          ADDLIST (list add))
    (while add
      (setq glist (append glist ADDLIST))
      (setq add (read-line lst))
      (setq ADDLIST (list add))
    )
    (close lst)
    (start_list "groups")
    (mapcar 'add_list GLIST)
    (end_list)
  )
  (defun SHOW_L ()
    (start_list "layr")
    (mapcar 'add_list LLIST)
    (end_list)
  )
  (defun L_SORT ()
    (setq Z 1)
    (while (/= (SUBSTR LAYT Z 1) " ")
      (SETQ Z (+ Z 1))
    )
    (setq Z (- Z 1))
  )
  (defun DO_GROUP ()
    (setq LAYN nil)
    (DO_LIST)
    (SHOW_L)
    (reset_mod)
  )
  (defun reset_mod ()
    (setq MOD2 "NONE" MOD1
          nil)
    (set_tile "NONE" "1")
    (set_tile "mod1" "")
    (set_tile "NOAN" "1")
  )
  (defun DO_LIST ()
    (mode_tile gn 2)
    (LIST_NAME)
    (DO_LIST2)
    (if fl
      (set_tile "groups" fl)
      (set_tile "groups" "0")
    )
  )
  (defun DO_LIST2 (/ ADDLIST)
    (if (setq lst (open fle "r"))
      (progn
        (setq LLIST (list (read-line lst))
              add (read-line lst)
              ADDLIST (list add))
        (while add
          (setq llist (append llist ADDLIST))
          (setq add (read-line lst))
          (setq ADDLIST (list add))
        )
        (close lst)
      )
      (progn
        (setq llist (list ""))
        (SHOW_L)
        (ADD_LAYER)
      )
    )
  )
  (defun OOPS (/ BAKDATE BAKDATE2)
    (if (not (new_dialog "DDCLSC" dcl_id))
      (exit)
    )
    (if (setq xxx (open flb "r"))
      (progn
        (setq BAKDATE (read-line xxx)
              BAKDATE2 (read-line xxx))
        (close xxx)
      )
      (setq BAKDATE (strcat "There is no backup file for " fle)
            BAKDATE2 "")
    )
    (set_tile "lastbak" BAKDATE)
    (set_tile "lastbak2" BAKDATE2)
    (action_tile "accept" "(OOPS2) (done_dialog)")
    (action_tile "cancel" "(done_dialog)")
    (start_dialog)
    (DO_GROUP)
  )
  (defun OOPS2 ()
    (if (setq xxx (open flb "r"))
      (progn
        (setq yyy (open fle "w"))
        (read-line xxx)
        (read-line xxx)
        (read-line xxx)
        (setq xxa (read-line xxx))
        (while xxa
          (write-line xxa yyy)
          (setq xxa (read-line xxx))
        )
        (close xxx)
        (close yyy)
      )
    )
  )
  (defun EDIT_LAYER (/ DOEDIT)
    (if LAYN
      (progn
        (setq editflag 1
              FLG (strcat (strcase (substr gn 1 1)) "-"))
        (if (not (new_dialog "DDCLSE" dcl_id))
          (exit)
        )
        (setq LAYDES (substr LAYP 31))
        (setq lname LAYN
              lltype LAYLT
              lcolor LAYC
              ldesc LAYDES)
        (action_tile "elname" "(setq lname $value)(chk_layn)")
        (action_tile "elltype" "(setq lltype $value)(chk_laylt)")
        (action_tile "elcolor" "(setq lcolor $value)(chk_layc)")
        (action_tile "eldesc" "(setq ldesc $value)")
        (action_tile "accept" "(setq doedit 1)(done_dialog)")
        (action_tile "cancel" "(done_dialog)")
        (set_tile "elname" LAYN)
        (set_tile "elltype" LAYLT)
        (set_tile "elcolor" LAYC)
        (set_tile "eldesc" LAYDES)
        (start_dialog)
        (if doedit
          (do_edit)
        )
        (princ)
      )
      (progn
        (set_tile "error" "IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "EDIT IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "YOU CAN EDIT IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "BEFORE YOU CAN EDIT IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "LIST BEFORE YOU CAN EDIT IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "LAYER LIST BEFORE YOU CAN EDIT IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error"
                "A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
                "SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
        "MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
   "*** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"             *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"                           *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"                                         *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN EDIT IT ***"
        )
      )
    )
  )                                  ; end EDIT_LAYER
  (defun chk_layn (/ TILEN)          ;  (if editflag (setq tilen "elname")(setq-
                                     ; tilen "lname"))
    ;;  (setq lname (strcase lname) chflag nil)
    ;;  (cond
    ;;    ((/= (strlen lname) 11)(setq chflag 1))
    ;;    ((or (/= (substr lname 1 2) FLG) (/= (substr lname 7 1) "-"))(setq
    ;;chflag 1))
    ;;  )
    ;;  (if (= lname "DEFPOINTS") (setq chflag nil))
    ;;  (if chflag
    ;;    (progn
    ;;      (set_tile tilen "")
    ;;      (setq chkerr (strcat lname " is an \"improper\" Layer Name.....Try
    ;;again!") doadd nil)
    ;;      (set_tile "error" chkerr)
    ;;      (set_tile "lname" FLG)
    ;;    )
    ;;    (set_tile "error" "")
    ;;  )
    (princ)
  )
  (defun chk_laylt (/ TILEN)
    (if editflag
      (setq tilen "elltype")
      (setq tilen "lltype")
    )
    (setq chflag 1
          ltlen (strlen lltype)
          lltype (strcase lltype))
    (setq linfile (open (findfile "acad.lin") "r"))
    (setq linline (read-line linfile))
    (while linline
      (if (= (substr linline 2 ltlen) lltype)
        (setq chflag nil)
      )
      (setq linline (read-line linfile))
    )
    (close linfile)
    (if (= lltype "CONTINUOUS")
      (setq chflag nil)
    )
    (if chflag
      (progn
        (set_tile tilen "")
        (setq chkerr (strcat lltype
                           " is not a \"legal\" Line Type.....Try again!"
                     )
              doadd nil)
        (set_tile "error" chkerr)
      )
      (set_tile "error" "")
    )
  )
  (defun chk_layc (/ TILEN)
    (setq chflag nil)
    (if editflag
      (setq tilen "elcolor")
      (setq tilen "lcolor")
    )
    (cond
      ((or (= (strcase lcolor) "RED") (= (strcase lcolor) "R")) (setq lcolor
                                                                    "001")
      )
      ((or (= (strcase lcolor) "YELLOW") (= (strcase lcolor) "Y")) (setq lcolor
                                                                       "002")
      )
      ((or (= (strcase lcolor) "GREEN") (= (strcase lcolor) "G")) (setq lcolor
                                                                      "003")
      )
      ((or (= (strcase lcolor) "CYAN") (= (strcase lcolor) "C")) (setq lcolor
                                                                     "004")
      )
      ((or (= (strcase lcolor) "BLUE") (= (strcase lcolor) "B")) (setq lcolor
                                                                     "005")
      )
      ((or (= (strcase lcolor) "MAGENTA") (= (strcase lcolor) "M"))
       (setq lcolor "006")
      )
      ((or (= (strcase lcolor) "WHITE") (= (strcase lcolor) "W")) (setq lcolor
                                                                      "007")
      )
    )
    (if (setq layci (atoi lcolor))
      (if (or (< layci 1) (> layci 255))
        (setq chflag 1)
      )
      (setq chflag 1)
    )
    (if chflag
      (progn
        (set_tile tilen "")
        (setq chkerr (strcat lcolor " is not a \"legal\" Color.....Try again!")
              doadd nil)
        (set_tile "error" chkerr)
      )
      (progn
        (set_tile "error" "")
        (set_tile tilen lcolor)
      )
    )
  )
  (defun ADD_LAYER ()
    (setq doadd nil
          editflag nil
          FLG (strcat FLG "-"))
    (if (not (new_dialog "DDCLSA" dcl_id))
      (exit)
    )
    (set_tile "error" "Press [Esc] to cancel this dialog.")
    (set_tile "lname" FLG)
    (setq lname FLG
          lltype "CONTINUOUS" lcolor "")
    (action_tile "lname" "(setq lname $value)(chk_layn)")
    (action_tile "lltype" "(setq lltype $value)(chk_laylt)")
    (action_tile "lcolor" "(setq lcolor $value)(chk_layc)")
    (action_tile "ldesc" "(setq ldesc $value)")
    (action_tile "accept"
"(setq doadd 1)(chk_layn)(if doadd (chk_laylt))(if doadd (chk_layc))(if doadd (done_dialog))"
    )
    (action_tile "cancel" "(done_dialog)")
    (start_dialog)
    (if doadd
      (set_tile "error"
              "Select point in Layer List ABOVE insert point of new layer: "
      )
    )
    (princ)
  )                                  ; end ADD_LAYER
  (defun DO_EDIT (/ NEWLINE)
    (setq xxx (open fle "r")
          yyy (open flb "w"))
    (write-line "Last change to this Layer List:" yyy)
    (write-line (strcat lname " edited on " CDATE) yyy)
    (write-line " " yyy)
    (setq xxa (read-line xxx))
    (while xxa
      (write-line xxa yyy)
      (setq xxa (read-line xxx))
    )
    (close xxx)
    (close yyy)
    (setq lnamel (- 13 (strlen lname))
          lltypel (- 12 (strlen lltype)))
    (repeat lnamel
      (setq lname (strcat lname " "))
    )
    (repeat lltypel
      (setq lltype (strcat lltype " "))
    )
    (setq elname (strcase lname)
          lltype (strcase lltype)
          newline (strcat lname lltype lcolor "  " ldesc))
    (setq xxx (open flb "r")
          yyy (open fle "w"))
    (repeat 3
      (read-line xxx)
    )
    (setq X (atoi X))
    (repeat X
      (write-line (read-line xxx) yyy)
    )
    (write-line newline yyy)
    (read-line xxx)
    (setq xxa (read-line xxx))
    (while xxa
      (write-line xxa yyy)
      (setq xxa (read-line xxx))
    )
    (close xxx)
    (close yyy)
    (setq doedit nil)
    (DO_LIST2)
    (SHOW_L)
  )                                  ; end DO_EDIT
  (defun DO_ADD (/ NEWLINE)
    (setq xxx (open fle "r")
          yyy (open flb "w"))
    (write-line "Last change to this Layer List:" yyy)
    (write-line (strcat lname " added on " CDATE) yyy)
    (write-line " " yyy)
    (setq xxa (read-line xxx))
    (while xxa
      (write-line xxa yyy)
      (setq xxa (read-line xxx))
    )
    (close xxx)
    (close yyy)
    (setq lnamel (- 13 (strlen lname))
          lltypel (- 12 (strlen lltype)))
    (repeat lnamel
      (setq lname (strcat lname " "))
    )
    (repeat lltypel
      (setq lltype (strcat lltype " "))
    )
    (setq lname (strcase lname)
          lltype (strcase lltype)
          newline (strcat lname lltype lcolor "  " ldesc))
    (setq xxx (open flb "r")
          yyy (open fle "w"))
    (repeat 3
      (read-line xxx)
    )
    (setq X (1+ (atoi X)))
    (repeat X
      (write-line (read-line xxx) yyy)
    )
    (write-line newline yyy)
    (setq xxa (read-line xxx))
    (while xxa
      (write-line xxa yyy)
      (setq xxa (read-line xxx))
    )
    (close xxx)
    (close yyy)
    (setq doadd nil)
    (DO_LIST2)
    (SHOW_L)
  )                                  ; end DO_ADD
  (defun DO_DEL (/ DELYN DLAYN LFILE)
    (if LAYN
      (progn                         ;     (if moving
        ;;      (setq delyn "accept")
        ;;      (progn
        (setq LAYP (nth (atoi X) LLIST))
        (setq LAYT (SUBSTR LAYP 1 13))
        (L_SORT)
        (setq LAYN (substr layt 1 Z)) ;       (if (= CHFLAG "cut")
        ;;         (setq DLAYN (strcat "Cut " LAYN "?"))
        (setq DLAYN (strcat "Delete " LAYN "?")) ;       )
        (if (not (new_dialog "DDCLSB" dcl_id))
          (exit)
        )
        (set_tile "delsure" DLAYN)
        (if (= CLAY LAYN)
          (repeat 5
            (repeat 10000
              nil
            )
            (set_tile "delcurr" "")
            (repeat 10000
              nil
            )
            (set_tile "delcurr" "*** IT IS THE CURRENT LAYER! ***")
          )
        )
        (action_tile "accept" "(setq delyn $key) (done_dialog)")
        (action_tile "cancel" "(setq delyn $key) (done_dialog)")
        (start_dialog)
        (princ)                      ;      )
        ;;     )
        (if (= delyn "accept")
          (progn                     ;          (if (= CHFLAG "cut")(setq-
                                     ; CLS_COPY LAYP))
            (setq xxx (open fle "r")
                  yyy (open flb "w"))
            (write-line "Last change to this Layer List:" yyy)
            (write-line (strcat LAYN " deleted on " CDATE) yyy)
            (write-line " " yyy)
            (setq xxa (read-line xxx))
            (while xxa
              (write-line xxa yyy)
              (setq xxa (read-line xxx))
            )
            (close xxx)
            (close yyy)
            (setq lfile (open fle "w"))
            (setq lcnt 0)
            (foreach lline LLIST
                     (progn
                       (if (/= lcnt (atoi X))
                         (write-line lline lfile)
                       )
                       (setq lcnt (+ lcnt 1))
                     )
            )
            (close lfile)
          )
        )
        (setq LAYN nil)
        (DO_GROUP)
      )
      (progn
        (set_tile "error" "IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "DELETE IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "YOU CAN DELETE IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "BEFORE YOU CAN DELETE IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "LIST BEFORE YOU CAN DELETE IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "LAYER LIST BEFORE YOU CAN DELETE IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error" "FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***")
        (repeat 100000
          nil
        )
        (set_tile "error"
                "A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
        "SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
        "MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"*** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"             *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"                           *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
        (repeat 100000
          nil
        )
        (set_tile "error"
"                                         *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN DELETE IT ***"
        )
      )
    )
  )                                  ; end DO_DEL
  (defun GET_LAY (/ LAYG)
    (setq demo nil)
    (mode_tile gn 2)
    (if X
      (if (and (> (atoi X) 5)
            (/= lok sercnf)
          )
        (progn
          (repeat 5
            (set_tile "error" "")
            (repeat 10000
              nil
            )
            (set_tile "error"
"**** You can only select the first five layers in the Demonstration Version ****"
            )
            (repeat 10000
              nil
            )
          )
          (setq demo 1)
        )
        (progn
          (setq LAYP (nth (atoi X) LLIST)) ;          (progn
          (IF (or (= (SUBSTR LAYP 1 1) "*") (= LAYP ""))
            (set_tile "error"
                    "NOT A VALID LAYER..................... PLEASE TRY AGAIN"
            )
            (PROGN
              (SETQ LAYT (SUBSTR LAYP 1 13))
              (L_SORT)
              (setq LAYR (substr layt 1 Z))
              (SETQ LAYT (SUBSTR LAYP 14 12))
              (L_SORT)
              (setq LAYLT1 (substr layt 1 Z)
                    LAYLT LAYLT1)
              (SETQ LAYC1 (SUBSTR LAYP 26 3)
                    LAYC LAYC1)
              (cond
                ((= STATUS "NEWW") (setq LAYLT NEWWlt
                                         LAYC NEWWc)
                )
                ((= STATUS "EXST") (setq LAYLT EXSTlt
                                         LAYC EXSTc)
                )
                ((= STATUS "DEMO") (setq LAYLT DEMOlt
                                         LAYC DEMOc)
                )
                ((= STATUS "FUTR") (setq LAYLT FUTRlt
                                         LAYC FUTRc)
                )
                ((= STATUS "TEMP") (setq LAYLT TEMPlt
                                         LAYC TEMPc)
                )
                ((= STATUS "MOVE") (setq LAYLT MOVElt
                                         LAYC MOVEc)
                )
                ((= STATUS "RELO") (setq LAYLT RELOlt
                                         LAYC RELOc)
                )
                ((= STATUS "NICN") (setq LAYLT NICNlt
                                         LAYC NICNc)
                )
                ((= ANNO "DIMS") (setq LAYLT "CONTINUOUS" LAYCC
                                       DIMSc)
                )
                ((= ANNO "NOTE") (setq LAYLT "CONTINUOUS" LAYCC
                                       NOTEc)
                )
                ((= ANNO "PATT") (setq LAYLT "CONTINUOUS" LAYCC
                                       PATTc)
                )
                ((= ANNO "SYMB") (setq LAYLT "CONTINUOUS" LAYCC
                                       SYMBc)
                )
                ((= ANNO "KEYN") (setq LAYLT "CONTINUOUS" LAYCC
                                       KEYNc)
                )
                ((= ANNO "LEGN") (setq LAYLT "CONTINUOUS" LAYCC
                                       LEGNc)
                )
                ((= ANNO "TEXT") (setq LAYLT "CONTINUOUS" LAYCC
                                       TEXTc)
                )
                ((= ANNO "TTLB") (setq LAYLT "CONTINUOUS" LAYCC
                                       TTLBc)
                )
              )
              (if (= LAYLT "NoChange")
                (setq LAYLT LAYLT1)
              )
              (if (= LAYC "NoChange")
                (setq LAYC LAYC1)
              )
              (if LAYCC
                (setq LAYC LAYCC)
              )
              (SETQ LAYCC nil)
              (setq LAYN LAYR)
              (if (/= PHASE "")
                (setq LAYN (strcat LAYN "-" PHASE))
              )
              (if (/= REV "")
                (setq LAYN (strcat LAYN "-" REV))
              )
              (if (/= MOD "")
                (setq LAYN (strcat LAYN "-" MOD))
              )
              (if (/= STATUS "NONE")
                (setq LAYN (strcat LAYN "-" STATUS))
              )
              (if (/= ANNO "NOAN")
                (setq LAYN (strcat LAYN "-" ANNO))
              )
              (if (/= DISC2 "")
                (setq LAYN (strcat (substr LAYN 1 1) DISC2 (substr LAYN 2)))
              )
              (LIST_NAME)            ;                (setq LAYG (substr LAYN 1-
                                     ; 6))
            )                        ;end progn
          )                          ;          )
        )
      )
    )
    (if doadd
      (DO_ADD)
    )
  )                                  ; end GET_LAY
  (defun TEST_IT ()
    (PRINC LAYN)
    (PRINC "|**|")
    (if (= CHFLAG nil)
      (GET_LAY)
    )
    (PRINC LAYN)
    (PRINC "|**|")
  )
  (defun ch_err ()
    (setq CHFLAG nil)
    (set_tile "error" "IT ***")
    (repeat 100000
      nil
    )
    (set_tile "error" "MOVE ENTITIES ***")
    (repeat 100000
      nil
    )
    (set_tile "error" "YOU CAN MOVE ENTITIES ***")
    (repeat 100000
      nil
    )
    (set_tile "error" "BEFORE YOU CAN MOVE ENTITIES ***")
    (repeat 100000
      nil
    )
    (set_tile "error" "LIST BEFORE YOU CAN MOVE ENTITIES ***")
    (repeat 100000
      nil
    )
    (set_tile "error" "LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***")
    (repeat 100000
      nil
    )
    (set_tile "error" "FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***")
    (repeat 100000
      nil
    )
    (set_tile "error"
            "A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
    (repeat 100000
      nil
    )
    (set_tile "error"
    "SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
    (repeat 100000
      nil
    )
    (set_tile "error"
    "MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
    (repeat 100000
      nil
    )
    (set_tile "error"
"*** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
    (repeat 100000
      nil
    )
    (set_tile "error"
"             *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
    (repeat 100000
      nil
    )
    (set_tile "error"
"                           *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
    (repeat 100000
      nil
    )
    (set_tile "error"
"                                         *** YOU MUST SELECT A LAYER FROM THE LAYER LIST BEFORE YOU CAN MOVE ENTITIES ***"
    )
  )
  (defun rev_no ()
    (if (= (strlen REV) 1)
      (setq REV (strcat "RV0" REV))
      (setq REV (strcat "RV" REV))
    )
    (if (= REV "RV")
      (setq REV "")
    )
    (set_tile "rev" REV)
  )
  (defun do_ph ()
    (setq PHASEN PHASE
          PHASE (nth (atoi PHASEN) PHLIST)) ;(princ phase)
    (if (/= PHASE "")
      (setq PHASE (strcat "PHS" PHASE))
    )
    (if LAYN
      (GET_LAY)
    )
  )
  (defun test_tool (chtest)
    (setq TOOLFLG nil)
    (cond
      ((and (= chtest "Group")
         (null LAYN)
       )
       (set_tile "error"
"                             *** ERROR! First you MUST select a layer in the Layer List to indicate which Group ***"
       )
      )
      ((and (= chtest "Layer")
         (null LAYN)
       )
       (set_tile "error"
"                                                                          *** ERROR! You MUST select a LAYER  first ***"
       )
      )
      ((and (= chtest "Status")
         (= STATUS "NONE")
       )
       (set_tile "error"
"                                     *** ERROR! First you MUST select a STATUS code other than NONE ***"
       )
      )
      ((and (= chtest "Annotation")
         (= ANNO "NOAN")
       )
       (set_tile "error"
"                            *** ERROR! First you MUST select an ANNOTATION code other than NONE ***"
       )
      )
      ((and (= chtest "Phase")
         (= PHASE "")
       )
       (set_tile "error"
"                                            *** ERROR! First you MUST select a number from the PHASE popup list ***"
       )
      )
      ((and (= chtest "Revision")
         (= REV "")
       )
       (set_tile "error"
"                                                 *** ERROR! First you must enter a number in the REVISION box ***"
       )
      )
      ((and (= chtest "Other")
         (= MOD "")
       )
       (set_tile "error"
"                                                *** ERROR! First you must enter a 4 digit modifier in the OTHER box ***"
       )
      )
      (T
        (progn
          (setq TOOLFLG 1)
          (done_dialog)
        )
      )
    )
    (if (not TOOLFLG)
      (progn
        (setq TFUNC nil)
        (set_tile CHFLAG "")
      )
    )
  )
  (defun do_lock ()
    (if LOCKON
      (progn
        (setq LOCKON nil
              PHASE "" REV ""
              MOD "")
        (set_tile "phase" "0")
        (set_tile "rev" "")
        (set_tile "mod" "")
      )
      (setq LOCKON 1)
    )
  )
  (defun MAINCLS (/ DEF_DIS DTE YR MO HR MNT DY OLDLAY SS TOOLFLG)
    (IF (and (NOT DDCLS_GO_AHEAD)
          (NOT DDCLS_DEMO_FLG)
        )
      (EXIT)
    )
    (setq gnl (list "Architectural" "Structural" "Mechanical" "Plumbing"
                  "Fire Protection" "Electrical" "Civil" "Landscaping" "General"
                  "Hazardous" "Interiors" "Equipment" "Resource"
                  "Telecommunications" "Contractor" "Other"
              ))
    (setq PHLIST (list "" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E"
                     "F" "G" "H" "J"
                 )
          LTOOL (list "" "Discipline" "Group" "Layer" "Status" "Annotation"
                    "Phase" "Revision" "Other"
                ))
    (setq DEF_FILE (strcat DDCLSDIR "ddcls.ini")
          DEF_DIS (open DEF_FILE "r")
          gnn (read-line DEF_DIS)
          EDITLOK (read-line DEF_DIS)
          EDITLOK (substr EDITLOK 14 1))
    (setq NEWWlt (read-line DEF_DIS)
          NEWWlt (substr NEWWlt 14))
    (setq NEWWc (read-line DEF_DIS)
          NEWWc (substr NEWWc 11))
    (setq EXSTlt (read-line DEF_DIS)
          EXSTlt (substr EXSTlt 14))
    (setq EXSTc (read-line DEF_DIS)
          EXSTc (substr EXSTc 11))
    (setq DEMOlt (read-line DEF_DIS)
          DEMOlt (substr DEMOlt 14))
    (setq DEMOc (read-line DEF_DIS)
          DEMOc (substr DEMOc 11))
    (setq FUTRlt (read-line DEF_DIS)
          FUTRt (substr FUTRlt 14))
    (setq FUTRc (read-line DEF_DIS)
          FUTRc (substr FUTRc 11))
    (setq TEMPlt (read-line DEF_DIS)
          TEMPlt (substr TEMPlt 14))
    (setq TEMPc (read-line DEF_DIS)
          TEMPc (substr TEMPc 11))
    (setq MOVElt (read-line DEF_DIS)
          MOVElt (substr MOVElt 14))
    (setq MOVEc (read-line DEF_DIS)
          MOVEc (substr MOVEc 11))
    (setq RELOlt (read-line DEF_DIS)
          RELOlt (substr RELOlt 14))
    (setq RELOc (read-line DEF_DIS)
          RELOc (substr RELOc 11))
    (setq NICNlt (read-line DEF_DIS)
          NICNlt (substr NICNlt 14))
    (setq NICNc (read-line DEF_DIS)
          NICNc (substr NICNc 11))
    (setq DIMSc (read-line DEF_DIS)
          DIMSc (substr DIMSc 11))
    (setq NOTEc (read-line DEF_DIS)
          NOTEc (substr NOTEc 11))
    (setq PATTc (read-line DEF_DIS)
          PATTc (substr PATTc 11))
    (setq SYMBc (read-line DEF_DIS)
          SYMBc (substr SYMBc 11))
    (setq KEYNc (read-line DEF_DIS)
          KEYNc (substr KEYNc 11))
    (setq LEGNc (read-line DEF_DIS)
          LEGNc (substr LEGNc 11))
    (setq TEXTc (read-line DEF_DIS)
          TEXTc (substr TEXTc 11))
    (setq TTLBc (read-line DEF_DIS)
          TTLBc (substr TTLBc 11))
    (close DEF_DIS)
    (if (not (tblsearch "block" "ddcls"))
      (progn
        (setq gnn (- (atoi (substr gnn 19)) 1)
              gnx (itoa gnn)
              gnn (nth gnn gnl)
              gn (strcase (substr gnn 1 4) 1)
              attr (getvar "attreq")
              attd (getvar "attdia")
              CLAY (getvar "clayer"))
        (setvar "attdia" 0)
        (setvar "attreq" 1)
        (command "layer" "m" "G-ANNO-DCLS" "")
        (command "insert" (findfile "ddcls.dwg") "0,0" "" "" "" gnx "0")
        (setvar "clayer" CLAY)
        (setvar "attreq" attr)
        (princ)
      )
    )
    (progn
      (command "layer" "thaw" "G-ANNO-DCLS" "on" "G-ANNO-DCLS" "unlock"
             "G-ANNO-DCLS" ""
      )
      (setq gnxa (ssget "x" (list (cons 0 "INSERT") (cons 2 "DDCLS")))
            gnxa (ssname gnxa 0)
            gnxb (entnext gnxa)
            gnxb1 (entget gnxb)
            gnxb2 (cdr (assoc 1 gnxb1))
            gnx (atoi gnxb2)
            gnn (nth gnx gnl)
            gn (strcase (substr gnn 1 4) 1)
            dte (rtos (getvar "cdate") 2 4)
            yr (substr dte 3 2)
            mo (substr dte 5 2)
            dy (substr dte 7 2)
            hr (substr dte 10 2)
            mnt (substr dte 12 2)
            CDATE (strcat mo "/" dy "/" yr " " hr ":" mnt)
            STATUS "NONE" DISC2 ""
            ANNO "NOAN")
    )
    (setvar "cmdecho" 0)
    (if LOCKON
      (PROGN
        (if (not (new_dialog "DDCLSU" dcl_id))
          (exit)
        )
        (set_tile "phase" PHASEN)
        (set_tile "rev" REV)
        (set_tile "mod" MOD)
      )
      (progn
        (if (not (new_dialog "DDCLSL" dcl_id))
          (exit)
        )
        (setq PHASE "" REV ""
              MOD "")
      )
    )
    (action_tile "arch"
    "(setq gn $key gnn \"Architectural\")(SHOW_G)(setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "stru"
    "(setq gn $key gnn \"Structural\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "mech"
    "(setq gn $key gnn \"Mechanical\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "plum"
    "(setq gn $key gnn \"Plumbing\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "fire"
"(setq gn $key gnn \"Fire Protection\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "elec"
    "(setq gn $key gnn \"Electrical\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "civi"
    "(setq gn $key gnn \"Civil\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "land"
    "(setq gn $key gnn \"Landscaping\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "gene"
    "(setq gn $key gnn \"General\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "haza"
    "(setq gn $key gnn \"Hazardous\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "inte"
    "(setq gn $key gnn \"Interiors\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "equi"
    "(setq gn $key gnn \"Equipment\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "reso"
    "(setq gn $key gnn \"Resource\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "tele"
"(setq gn $key gnn \"Telecommunications\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "othe"
    "(setq gn $key gnn \"Other\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "cont"
    "(setq gn $key gnn \"Contractor\") (SHOW_G) (setq fl \"0\" dt 1)(DO_GROUP)"
    )
    (action_tile "disc2"
  "(setq DISC2 (strcase $value))(chg_error)(if LAYN (GET_LAY))(mode_tile gn 2)"
    )
    (action_tile "groups" "(setq fl $value CHFLAG $key)(DO_GROUP)")
    (action_tile "addl" "(setq CHFLAG $key)(ADD_LAYER)")
    (action_tile "dell" "(setq CHFLAG $key)(DO_DEL)")
    (action_tile "editl" "(setq CHFLAG $key)(EDIT_LAYER)")
    (action_tile "oops" "(setq CHFLAG $key)(OOPS)")
    (action_tile "cancel" "(done_dialog)")
    (action_tile "clshlp" "(help \"ddcls.hlp\" \"The_DDCLS_Dialog\")")
    (action_tile "layr" "(setq X $value chflag nil)(GET_LAY)")
    (action_tile "change" "(setq CHFLAG $key)(if X (done_dialog)(ch_err))")
    (action_tile "NONE" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "EXST" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "DEMO" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "NEWW" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "FUTR" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "TEMP" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "MOVE" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "RELO" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "NICN" "(setq STATUS $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "NOAN" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "DIMS" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "NOTE" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "PATT" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "SYMB" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "KEYN" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "LEGN" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "TEXT" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "TTLB" "(setq ANNO $key) (if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "phase" "(setq PHASE $value)(do_ph)(mode_tile gn 2)")
    (action_tile "rev"
               "(setq REV $value)(rev_no)(if LAYN (GET_LAY)(mode_tile gn 2))"
    )
    (action_tile "mod" "(setq MOD $value)(if LAYN (GET_LAY)(mode_tile gn 2))")
    (action_tile "lockmod" "(do_lock)(if LAYN (GET_LAY))(mode_tile gn 2)")
    (action_tile "freeze"
    "(setq TFUNC (nth (atoi $value) LTOOL) CHFLAG \"freeze\")(test_tool TFUNC)"
    )
    (action_tile "toff"
    "(setq TFUNC (nth (atoi $value) LTOOL) CHFLAG \"off\")(test_tool TFUNC)"
    )
    (action_tile "lock"
    "(setq TFUNC (nth (atoi $value) LTOOL) CHFLAG \"lock\")(test_tool TFUNC)"
    )
    (action_tile "thaw"
    "(setq TFUNC (nth (atoi $value) LTOOL) CHFLAG \"thaw\")(test_tool TFUNC)"
    )
    (action_tile "ton"
    "(setq TFUNC (nth (atoi $value) LTOOL) CHFLAG \"on\")(test_tool TFUNC)"
    )
    (action_tile "unlock"
    "(setq TFUNC (nth (atoi $value) LTOOL) CHFLAG \"unlock\")(test_tool TFUNC)"
    )
    (action_tile "accept" "(TEST_IT)")
    (set_tile "logo" "")
    (setq x (dimx_tile "logo"))
    (setq y (dimy_tile "logo"))
    (start_image "logo")
    (slide_image 0 0 x y "DDCLS(crc)")
    (end_image)
    (SHOW_G)
    (if gnxa
      (setq gnxc (entnext gnxb)
            gnxc1 (entget gnxc)
            fl (cdr (assoc 1 gnxc1)))
      (setq fl "0")
    )
    (DO_GROUP)
    (start_list "layr")
    (mapcar 'add_list LLIST)
    (end_list)
    (start_list "phase")
    (mapcar 'add_list PHLIST)
    (end_list)
    (start_list "freeze")
    (mapcar 'add_list LTOOL)
    (end_list)
    (start_list "thaw")
    (mapcar 'add_list LTOOL)
    (end_list)
    (start_list "toff")
    (mapcar 'add_list LTOOL)
    (end_list)
    (start_list "ton")
    (mapcar 'add_list LTOOL)
    (end_list)
    (start_list "lock")
    (mapcar 'add_list LTOOL)
    (end_list)
    (start_list "unlock")
    (mapcar 'add_list LTOOL)
    (end_list)
    (setq DDCLSTTL (strcat "DDCLS 7.0 - Layer Management Utility    Serial No."
                           DDCLSERNO "     Copyright (c) 2000 Glen E. Eich"
                   ))
    (if (= EDITLOK "0")
      (progn
        (mode_tile "addl" 1)
        (mode_tile "dell" 1)
        (mode_tile "editl" 1)
        (mode_tile "oops" 1)
      )
    )
    (set_tile "ddclsttl" DDCLSTTL)
    (set_tile "groups" fl)
    (start_dialog)                   ;  (IF GUMBY (DONE_DIALOG))
    (unload_dialog dcl_id)
    (setq oldlay (getvar "clayer"))
    (if (and LAYN
          (or (= CHFLAG "change") (= CHFLAG nil) (= CHFLAG "alloff"))
          (/= demo 1)
        )
      (progn
        (if (not (tblsearch "ltype" LAYLT))
          (command "linetype" "l" LAYLT "ACAD" "")
        )
        (IF (TBLSEARCH "LAYER" LAYN)
          (COMMAND "LAYER" "ON" LAYN "T" LAYN "S" LAYN "")
          (COMMAND "LAYER" "M" LAYN "LT" LAYLT "" "C" LAYC "" "")
        )
        (command "layer" "thaw" "G-ANNO-DCLS" "on" "G-ANNO-DCLS" "unlock"
               "G-ANNO-DCLS" ""
        )
        (setq CNT 0)
        (repeat 16
          (setq gnc (nth CNT gnl))
          (if (= gnc gnn)
            (setq gnx (+ CNT 1))
          )
          (setq CNT (+ CNT 1))
        )
        (setq gnxb1 (subst (cons 1 (itoa (- gnx 1))) (assoc 1 gnxb1) gnxb1)
              gnxc1 (subst (cons 1 FL) (assoc 1 gnxc1) gnxc1))
        (entmod gnxb1)
        (entmod gnxc1)
        (entupd gnxb)
        (entupd gnxc)
      )
    )
    (cond
      ((= gn "equi") (setq D1 "Q"))
      ((= gn "othe") (setq D1 "X"))
      ((= gn "cont") (setq D1 "Z"))
      (T
        (setq D1 (substr gn 1 1))
      )
    )
    (if (/= DISC2 "")
      (setq DP 2
            D1 (strcat D1 DISC2))
      (setq DP 1)
    )
    (if TOOLFLG
      (cond
        ((= TFUNC "Discipline") (command ".layer" CHFLAG (strcat D1 "-*") ""))
        ((= TFUNC "Group") (command ".layer" CHFLAG (strcat (substr LAYN 1
                                                                    (+ DP 5)
                                                            ) "*"
                                                    ) ""
                           )
        )
        ((= TFUNC "Layer") (command ".layer" CHFLAG LAYN ""))
        ((= TFUNC "Status") (command ".layer" CHFLAG (strcat "*" STATUS "*") ""))
        ((= TFUNC "Annotation") (command ".layer" CHFLAG (strcat "*" ANNO "*") ""))
        ((= TFUNC "Phase") (command ".layer" CHFLAG (strcat "*" PHASE "*") ""))
        ((= TFUNC "Revision") (command ".layer" CHFLAG (strcat "*" REV "*") ""))
        ((= TFUNC "Other") (command ".layer" CHFLAG (strcat "*" MOD) ""))
      )
    )
    (if (= CHFLAG "change")
      (progn
        (princ (strcat "Selected objects will be placed on layer " LAYN))
        (setq ss (ssget))
        (command "chprop" ss "" "la" LAYN "")
        (setvar "clayer" oldlay)
      )
    )
    (princ)
  )                                  ; end MAINCLS
  (defun ddcls_reg (/ REG_OK)
    (if (not (new_dialog "DDCLSR" dcl_id))
      (exit)
    )
    (mode_tile "name" 2)
    (action_tile "name" "(setq name $value) (mode_tile \"code\" 2)")
    (action_tile "code" "(setq lok $value)")
    (action_tile "accept" "(do_reg)")
    (action_tile "cancel" "(done_dialog)")
    (start_dialog)
    (if REG_OK
      (thanks)
    )
    (princ)
  )
  (defun do_reg ()
    (if (= lok sercnf)
      (progn
        (setq REG_OK 1)
        (done_dialog)
      )
      (set_tile "error" "Incorrect CODE, press cancel and try again.")
    )
  )
  (defun thanks ()
    (setq x (open codefile "w"))
    (write-line name x)
    (write-line lok x)
    (close x)
    (if (not (new_dialog "DDCLSW" dcl_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog)")
    (start_dialog)
    (if (not (new_dialog "DDCLSZ" dcl_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog)(add_load)")
    (action_tile "cancel" "(done_dialog)")
    (start_dialog)
    (princ)
  )
  (defun add_load (/ LSPFILE addit)
    (if (setq LSPFILE (findfile "acad.lsp"))
      (progn
        (setq addit (open LSPFILE "a"))
        (write-line "(autoload \"DDCLS\" '(\"DDCLS\"))" addit)
        (close addit)
      )
      (progn
        (setq exefile (findfile "acad.exe")
              exelen (- (strlen exefile) 3)
              lspfile (strcat (substr exefile 1 exelen) "lsp")
              addit (open LSPFILE "w"))
        (write-line "(autoload \"DDCLS\" '(\"DDCLS\"))" addit)
        (close addit)
      )
    )
    (princ)
  )
  (defun CLSDEMO (/ Y)
    (if (not (new_dialog "DDCLSD" dcl_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog)")
    (action_tile "ddclsr" "(ddcls_reg) (if REG_OK (done_dialog))")
    (action_tile "cancel" "(term_dialog)(exit)")
    (action_tile "what" "(help \"ddcls.hlp\" \"DDCLS\")")
    (set_tile "sign" "")
    (setq x (dimx_tile "sign"))
    (setq y (dimy_tile "sign"))
    (start_image "sign")
    (slide_image 0 0 x y "DDCLS(DDCLS)")
    (end_image)
    (set_tile "logo" "")
    (setq x (dimx_tile "logo"))
    (setq y (dimy_tile "logo"))
    (start_image "logo")
    (slide_image 0 0 x y "DDCLS(crc)")
    (end_image)
    (set_tile "error" (strcat "Serial Number: " DDCLSERNO))
    (start_dialog)
    (setq ddcls_demo_flg 1)
  )                                  ; end CLSDEMO
  ;; =================
  ;; C:DDCLS continued
  ;; =================
  (setq dcl_id (load_dialog "DDCLS.dcl"))
  (if ddcls_go_ahead
    (MAINCLS)
    (progn
      (setq serfile (findfile "acad.exe")
            serfilel (- (strlen serfile) 8)
            serfile (substr serfile 1 serfilel)
            serfile (strcat serfile "acadc.sys"))
      (setq lspfile (findfile "ddcls.lsp")
            lspfilel (- (strlen lspfile) 9)
            DDCLSDIR (substr lspfile 1 lspfilel)
            codefile "c:/ddcls.ser")
      (if (not (findfile serfile))
        (progn
          (setq ser (open serfile "w")
                aa (getvar "cdate")
                bb (rtos aa 2 8)
                cc (substr bb 10)
                ser (open serfile "a")
                CNT 1)
          (repeat 8
            (setq spaces "" ccd
                  (atoi (substr cc CNT 1)))
            (repeat ccd
              (setq spaces (strcat spaces " "))
            )
            (write-line spaces ser)
            (setq CNT (1+ CNT))
          )
          (close ser)
        )
      )
      (setq ser (open serfile "r")
            DDCLSERNO "")
      (repeat 8
        (setq nextline (read-line ser)
              linelen (strlen nextline)
              DDCLSERNO (strcat DDCLSERNO (itoa linelen)))
      )
      (close ser)
      (setq sercnt (strlen DDCLSERNO)
            CNT 1
            sercnf 0)
      (repeat sercnt
        (setq serdgt (ascii (substr DDCLSERNO CNT 1))
              serdgt (* serdgt CNT)
              sercnf (+ sercnf serdgt)
              CNT (+ CNT 1))
      )
      (setq sercnf (* sercnf sercnf)
            sercnf (rtos sercnf 2 0)) ;    (setq aa "c:/ddcls.ser")
      (if (setq ser (open codefile "r"))
        (progn
          (read-line ser)
          (setq lok (read-line ser))
          (close ser)
        )
      )
      (if (= lok sercnf)
        (setq ddcls_go_ahead 1)
        (CLSDEMO)
      )
      (MAINCLS)
    )
  )
  (setq *error* old_err)
  (princ)
)
;;;end C:DDCLS
(prompt "\nCAD Layer Standards Dialog Module Loaded")
(prompt ".... Enter DDCLS to Run Program")
(princ)

wlq0408

好像是一个创造dcl对话框的程序， 但具体怎么用，还请楼主讲得详细一点，谢谢！

shisj

请教一下楼主，这个程序能实现什麽功能啊？

lifuding

强烈要求楼主给出功能说明

20042005

不能使用啊？请楼主给出使用说明吧。

lhg

是呀！请楼主说明该程序如何用？有何功能？谢谢！！！

aidraft

我想是一个创建图层的程序，但没有DCL文件（也许还有其它），不能测试。

cadlmap

顶一下

ycao

程序是干什么的呀？

ch3028

好长，做什么用的也不知道哎

陌生人

大致扫了一眼，是一个图层处理的冬冬，可以把图层状态记录到文件。
不过好像程序里面加了测试版限制的处理，当然现在是解开了，可以去掉，更改。。。