[求助]：这段程序有什么功能

papayaa

;; WDWELE.LSP

;; started from 24-11-92

(setq SECTW 30 GROUT 25 SASHW 40 SASHO 0)
(setq SECTWA (list SECTW SECTW))
(setq SECTWS (list (- 0 SECTW) (- 0 SECTW)))
;
;(defun *ERROR* (ERR)
;  (setvar "osmode" 0 "highlight" 1)
;  (command "layer" "s" LAY "")
;  (grtext)
;  (princ "\n** ")
;  (princ ERR)
;  (princ " **")
;  (princ)
;)
;
(defun ELBOX (P1 P2)
  (setq P1 (addp LL SECTWA) P2 (addp UR SECTWS))
  (command "pline" P1 ".y" P1 P2 P2 ".y" P2 P1 "c")
)
;
(defun C:GROUT (/ GR)
  (setq GR (getint (strcat
            "\nEnter width of Grouting <" (itoa GROUT) ">: ")))
  (if GR (setq GROUT GR) GROUT)
)
;
(defun C:SECTW (/ SEC SHW SHO)
  (setq SEC (getint (strcat
             "\nEnter width of frame section <" (itoa (* SECTW 2)) ">: ")))
  (if SEC (setq SECTW (/ SEC 2) SASHW SEC))
  (setq SHW (getint (strcat
             "\nEnter width of Sash <" (itoa SASHW) ">: ")))
  (if SHW (setq SASHW SHW))
  (setq SHO (getint (strcat
             "\nEnter hinge offset <" (itoa SASHO) ">: ")))
  (if SHO (setq SASHO SHO))
  (setq SECTWA (list SECTW SECTW))
  (setq SECTWS (list (- 0 SECTW) (- 0 SECTW)))
)
;
(defun C:FRAME (/ WD WDT WDTL WDCNT HT HTT HTTL HTCNT LL UR pt1 pt2 ENTO)
  (setq WDT 0 HTT 0)
  (setq WD (getreal (strcat "\nEnter width #1 from left to right : "))
      WDTL (cons WD '()))
  (while WD
    (setq WDT (+ WD WDT)
      WD (getreal (strcat "\nEnter width #"
      (itoa (1+ (length WDTL))) " -- Total width = " (rtos WDT 2 1) " : ")))
    (if WD (setq WDTL (cons WD WDTL)))
    (princ WDTL)
  )
;  (setq WDTL (append (list (- (car WDTL) SECTW)) (cdr WDTL)))
;
  (setq HT (getreal (strcat "\nEnter height #1 from bottom to top : "))
      HTTL (cons HT '()))
  (while HT
    (setq HTT (+ HT HTT)
      HT (getreal (strcat "\nEnter height #"
      (itoa (1+ (length HTTL))) " -- Total height = " (rtos HTT 2 1) " : ")))
    (if HT (setq HTTL (cons HT HTTL)))
  )
;  (setq HTTL (append (list (- (car HTTL) SECTW)) (cdr HTTL)))
;
  (graphscr)
  (setq LL (getpoint "Enter window lower left point : "))
  (setq UR (addp LL (list WDT HTT)))
  (setq pt1 (addp LL SECTWS))
  (command "pline" LL ".y" LL UR UR ".y" UR LL "c")
  (setq ento (ssget "L"))
  (command "offset" GROUT LL pt1 "" "change" "L" "" "P" "lA" "das" "")
  (command "erase" ento "")
  (command "line" LL ".y" LL UR UR ".y" UR LL "c")
;  (setq LL (addp LL SECTWA))
;
;;  draw vertical lines
  (setq WDCNT (1- (length WDTL)))
  (setq pt1 LL)
  (while (> WDCNT 0)
    (progn
      (setq pt2 (list (+ (nth WDCNT WDTL) (car pt1)) (cadr UR)) )
      (setq pt1 (list (+ (nth WDCNT WDTL) (car pt1)) (cadr LL)) )
      (command "line" pt1 pt2 "")
      (setq WDCNT (1- WDCNT))
    )
  )
  (setq HTCNT (1- (length HTTL)))
  (setq pt1 LL)
  (while (> HTCNT 0)
    (progn
      (setq pt2 (list (car UR) (+ (nth HTCNT HTTL) (cadr pt1))) )
      (setq pt1 (list (car LL) (+ (nth HTCNT HTTL) (cadr pt1))) )
      (command "line" pt1 pt2 "")
      (setq HTCNT (1- HTCNT))
    )
  )
)


(defun C:SASH ( / pt1 pt2 ento x1 y1 x2 y2 SEL llist subent pt1 pt2 pt3 pt4 midp)
   (initget 1 "Left Right Top Bottom")
   (setq SEL (getkword "\nSelect hinge side Left/Right/Top/Bottom : "))
   (setq pt1 1)
   (while pt1
      (progn
       (setq x1 nil x2 nil y1 nil y2 nil)
       (initget "Left Right Top Bottom")
       (setq pt1 (getpoint (strcat "\nPoint to a window (" SEL ") : ")))
       (if pt1
          (progn
           (if (= (type pt1) 'STR)
              (setq SEL pt1)
           )
           (if (= (type pt1) 'LIST)
              (progn
;              (command "layer" "s" "das" "")
               (setq ento (c:bpoly pt1))
               (if ento
                  (progn
                   (setq subent ento)
                   (setq llist (entget subent))
                   (while (/= (cdr (assoc '0 llist)) "SEQEND")
                      (progn
                       (if (= (cdr (assoc '0 llist)) "VERTEX")
                          (progn
                           (if x1
                              (setq x1 (min x1 (cadr (assoc '10 llist))))
                              (setq x1 (cadr (assoc '10 llist)))
                           )
                           (if x2
                              (setq x2 (max x2 (cadr (assoc '10 llist))))
                              (setq x2 (cadr (assoc '10 llist)))
                           )
                           (if y1
                              (setq y1 (min y1 (cadr (cdr (assoc '10 llist)))))
                              (setq y1 (cadr (cdr (assoc '10 llist))))
                           )
                           (if y2
                              (setq y2 (max y2 (cadr (cdr (assoc '10 llist)))))
                              (setq y2 (cadr (cdr (assoc '10 llist))))
                           )
                          )
                       )
                       (setq subent (entnext subent))
                       (setq llist (entget subent))
                      )
                   )
                   (setq pt1 (strcat (rtos (+ x1 sectw)) "," (rtos (+ y1 sectw))))
                   (setq pt2 (strcat (rtos (- x2 sectw)) "," (rtos (+ y1 sectw))))
                   (setq pt3 (strcat (rtos (- x2 sectw)) "," (rtos (- y2 sectw))))
                   (setq pt4 (strcat (rtos (+ x1 sectw)) "," (rtos (- y2 sectw))))
                   (command "pline" pt1 ".y" pt1 pt3 pt3 ".y" pt3 pt1 "c")

                   (command "layer" "s" "das" "")
                   (cond ((= SEL "Left") (progn
                           (setq midp (strcat (rtos (+ x1 sectw)) "," (rtos (/ (+ y1 y2) 2))))
                           (command "pline" pt2 midp pt3 "")
                          )
                         )
                         ((= SEL "Right") (progn
                           (setq midp (strcat (rtos (- x2 sectw)) "," (rtos (/ (+ y1 y2) 2))))
                           (command "pline" pt1 midp pt4 "")
                          )
                         )
                         ((= SEL "Top") (progn
                           (setq midp (strcat (rtos (/ (+ x1 x2) 2)) "," (rtos (- y2 sectw))))
                           (command "pline" pt1 midp pt2 "")
                          )
                         )
                         ((= SEL "Bottom") (progn
                           (setq midp (strcat (rtos (/ (+ x1 x2) 2)) "," (rtos (+ y1 sectw))))
                           (command "pline" pt3 midp pt4 "")
                          )
                         )
                   )
                   (command "erase" ento "")
                   (command "layer" "s" "con" "")
                   (setq pt1 (strcat (rtos x1) "," (rtos y1)))
                   (setq pt3 (strcat (rtos x2) "," (rtos y2)))
                   (command "select" "C" pt1 pt3 "")
                  )
               )
              )
           )
          )
       )
      )
   )
)




(defun C:FIXED ( / pt1 pt2 ento x1 y1 x2 y2 llist subent)
   (setq pt1 1)
   (while pt1
      (progn
       (setq pt1 (getpoint "\nPoint to a fixed window : "))
       (if pt1
          (progn
;      (command "layer" "s" "das" "")
           (setq ento (c:bpoly pt1))
           (if ento
              (progn
               (setq x1 nil x2 nil y1 nil y2 nil)
               (setq subent ento)
               (setq llist (entget subent))
               (while (/= (cdr (assoc '0 llist)) "SEQEND")
                  (progn
                   (if (= (cdr (assoc '0 llist)) "VERTEX")
                      (progn
                       (if x1
                          (setq x1 (min x1 (cadr (assoc '10 llist))))
                          (setq x1 (cadr (assoc '10 llist)))
                       )
                       (if x2
                          (setq x2 (max x2 (cadr (assoc '10 llist))))
                          (setq x2 (cadr (assoc '10 llist)))
                       )
                       (if y1
                          (setq y1 (min y1 (cadr (cdr (assoc '10 llist)))))
                          (setq y1 (cadr (cdr (assoc '10 llist))))
                       )
                       (if y2
                          (setq y2 (max y2 (cadr (cdr (assoc '10 llist)))))
                          (setq y2 (cadr (cdr (assoc '10 llist))))
                       )
                      )
                   )
                   (setq subent (entnext subent))
                   (setq llist (entget subent))
                  )
               )
               (setq pt1 (strcat (rtos (/ (+ x1 x2) 2)) "," (rtos (/ (+ y1 y2) 2))))
               (command "text" "J" "MC" pt1 "" "F.")
               (command "layer" "s" "con" "")
              )
           )
          )
       )
      )
   )
)





(defun C:COUPLE ( / lent rent ment llist pt1 pt2 temp1 temp2 x1 x2 y1 y2)
   (setq ment 1)
   (while ment
      (progn
       (setq ment (entsel "\nSelect line : "))
       (if ment
          (progn
           (setq ment (car ment))
           (setq llist (entget ment))
           (if (= (cdr (assoc '0 llist)) "LINE")
              (progn
               ;;
               (setq pt1 (cdr (assoc '10 llist)))
               (setq x1 (car pt1))
               (setq y1 (cadr pt1))
               (setq pt2 (cdr (assoc '11 llist)))
               (setq x2 (car pt2))
               (setq y2 (cadr pt2))
               (if (equal x1 x2 0.0001)
                  (if (> y1 y2)
                     (progn
                      (setq temp1 pt1)
                      (setq pt1 pt2)
                      (setq pt2 temp1)
                     )
                  )
               )
               (if (equal y1 y2 0.0001)
                  (if (> x1 x2)
                     (progn
                      (setq temp1 pt1)
                      (setq pt1 pt2)
                      (setq pt2 temp1)
                     )
                  )
               )
               (if (equal x1 x2 0.0001)
                  ;;  the line is vertical
                  (progn
                   (setq temp1 (strcat (rtos (- x1 sectw)) "," (rtos y1)))
                   (setq temp2 (strcat (rtos (- x2 sectw)) "," (rtos y2)))
                   (command "pline" temp1 temp2 "")
                   (setq lent (ssget "L"))
                   (setq lent (ssname lent 0))
                   (setq temp1 (strcat (rtos (+ x1 sectw)) "," (rtos y1)))
                   (setq temp2 (strcat (rtos (+ x2 sectw)) "," (rtos y2)))
                   (command "pline" temp1 temp2 "")
                   (setq rent (ssget "L"))
                   (setq rent (ssname rent 0))
                   (setq pt1 (strcat (rtos x1) "," (rtos (+ y1 0.01))))
                   (setq pt2 (strcat (rtos x1) "," (rtos (- y2 0.01))))
                   (command "trim" lent rent "" "F" pt1 pt2 "" "")
                  )
               )
               (if (equal y1 y2 0.0001)
               ;;  the line is horizontal
                  (progn
                   (setq temp1 (strcat (rtos x1) "," (rtos (- y1 sectw))))
                   (setq temp2 (strcat (rtos x2) "," (rtos (- y2 sectw))))
                   (command "pline" temp1 temp2 "")
                   (setq lent (ssget "L"))
                   (setq lent (ssname lent 0))
                   (setq temp1 (strcat (rtos x1) "," (rtos (+ y1 sectw))))
                   (setq temp2 (strcat (rtos x2) "," (rtos (+ y2 sectw))))
                   (command "pline" temp1 temp2 "")
                   (setq rent (ssget "L"))
                   (setq rent (ssname rent 0))
                   (setq pt1 (strcat (rtos (+ x1 0.01)) "," (rtos y1)))
                   (setq pt2 (strcat (rtos (- x2 0.01)) "," (rtos y2)))
                  )
               )
;;              (command "trim" lent rent "" "F" pt1 pt2 "" "")
              )
           )
          )
       )
      )
   )
)

;
(defun C:CLEAR (/ LL UR)
  (setvar "osmode" 32)
  (initget 1)
  (setq LL (getpoint "\nLower left corner : "))
  (initget 1)
  (setq UR (getcorner LL "\nUpper Right corner : "))
  (setvar "osmode" 0)
  (command "erase" "c" LL UR "")
  (command "pline" LL ".y" LL UR UR ".y" UR LL "c")
)
;


(defun C:SPLIT ( / pt1 ento llist mode sno x1 x2 y1 y2 tx1 tx2 ty1 ty2
                    no wdwpt1 wdwpt2 subent remain inc dinc)
   (setq x1 nil x2 nil y1 nil y2 nil sno nil)
   (setq pt1 (getpoint "\nPoint to a fixed window : "))
   (if pt1
      (progn
       (setq ento (c:bpoly pt1))
       (if ento
          (progn
           (setq x1 nil x2 nil y1 nil y2 nil)
           (setq subent ento)
           (setq llist (entget subent))
           (while (/= (cdr (assoc '0 llist)) "SEQEND")
              (progn
               (if (= (cdr (assoc '0 llist)) "VERTEX")
                  (progn
                   (if x1
                      (setq x1 (min x1 (cadr (assoc '10 llist))))
                      (setq x1 (cadr (assoc '10 llist)))
                   )
                   (if x2
                      (setq x2 (max x2 (cadr (assoc '10 llist))))
                      (setq x2 (cadr (assoc '10 llist)))
                   )
                   (if y1
                      (setq y1 (min y1 (cadr (cdr (assoc '10 llist)))))
                      (setq y1 (cadr (cdr (assoc '10 llist))))
                   )
                   (if y2
                      (setq y2 (max y2 (cadr (cdr (assoc '10 llist)))))
                      (setq y2 (cadr (cdr (assoc '10 llist))))
                   )
                  )
               )
               (setq subent (entnext subent))
               (setq llist (entget subent))
              )
           )
           (command "ERASE" ento "")
           (setq wdwpt1 (strcat (rtos x1) "," (rtos y1)))
           (setq wdwpt2 (strcat (rtos x2) "," (rtos y2)))
           (command "SELECT" "C" wdwpt1 wdwpt2 "")
          )
       )
      )
   )
   (initget "V H")
   (setq mode (getkword "\nsplit Vertically/Horizontally ?"))
   (if mode
      (progn
       (initget 6)
       (setq sno (getint "\nno. of part to split : "))
       (if (> sno 1)
          (progn
           (if (= mode "H")
              (progn
               (setq remain (- x2 x1))
               (setq tx1 x1)
               (setq no 1)
               (while (< no sno )
                  (progn
                   (setq dinc (/ remain (+ (- sno no) 1)))
                   (setq inc remain)
                   (while (>= inc remain)
                      (progn
                       (initget 2)
                       (setq inc (getreal (strcat "\nwidth #" (rtos no) " <" (rtos dinc) "> :")))
                       (if (not inc) (setq inc dinc))
                      )
                   )
                   (setq tx1 (+ tx1 inc))
                   (setq tx2 tx1)
                   (setq ty1 y1)
                   (setq ty2 y2)
                   (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty1)))
                   (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
                   (command "line" wdwpt1 wdwpt2 "")
                   (setq no (+ 1 no))
                   (setq remain (- remain inc))
                  )
               )
              )
              (progn
               (setq remain (- y2 y1))
               (setq ty1 y1)
               (setq no 1)
               (while (< no sno )
                  (progn
                   (setq dinc (/ remain (+ (- sno no) 1)))
                   (setq inc remain)
                   (while (>= inc remain)
                      (progn
                       (initget 2)
                       (setq inc (getreal (strcat "\nheight #" (rtos no) " <" (rtos dinc) "> :")))
                       (if (not inc) (setq inc dinc))
                      )
                   )
                   (setq tx1 x1)
                   (setq tx2 x2)
                   (setq ty1 (+ ty1 inc))
                   (setq ty2 ty1)
                   (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty1)))
                   (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
                   (command "line" wdwpt1 wdwpt2 "")
                   (setq no (+ 1 no))
                   (setq remain (- remain inc))
                  )
               )
              )
           )
          )
       )
      )
   )
   (princ)
)

;;


(defun C:JOIN ( / pt1 ent1 ent2 mode subent llist x11 x12 y11 y12 x21 x22 y21 y22
                  ento tx1 tx2 ty1 ty2 wdwpt1 wdwpt2)
   (setq pt1 (getpoint "\nPoint in 1st window to be joined :"))
   (if pt1
      (progn
       (setq ento nil)
       (setq ento (c:bpoly pt1))
       (if ento
          (progn
           (setq x11 nil x12 nil y11 nil y12 nil)
           (setq subent ento)
           (setq llist (entget subent))
           (while (/= (cdr (assoc '0 llist)) "SEQEND")
              (progn
               (if (= (cdr (assoc '0 llist)) "VERTEX")
                  (progn
                   (if x11
                      (setq x11 (min x11 (cadr (assoc '10 llist))))
                      (setq x11 (cadr (assoc '10 llist)))
                   )
                   (if x12
                      (setq x12 (max x12 (cadr (assoc '10 llist))))
                      (setq x12 (cadr (assoc '10 llist)))
                   )
                   (if y11
                      (setq y11 (min y11 (cadr (cdr (assoc '10 llist)))))
                      (setq y11 (cadr (cdr (assoc '10 llist))))
                   )
                   (if y12
                      (setq y12 (max y12 (cadr (cdr (assoc '10 llist)))))
                      (setq y12 (cadr (cdr (assoc '10 llist))))
                   )
                  )
               )
               (setq subent (entnext subent))
               (setq llist (entget subent))
              )
           )
           (command "ERASE" ento "")
           (setq wdwpt1 (strcat (rtos x11) "," (rtos y11)))
           (setq wdwpt2 (strcat (rtos x12) "," (rtos y12)))
           (command "SELECT" "C" wdwpt1 wdwpt2 "")
          )
       )
      )
   )
   (setq pt1 (getpoint "\nPoint in 2nd window to be joined :"))
   (if pt1
      (progn
       (setq ento (c:bpoly pt1))
       (if ento
          (progn
           (setq x21 nil x22 nil y21 nil y22 nil)
           (setq subent ento)
           (setq llist (entget subent))
           (while (/= (cdr (assoc '0 llist)) "SEQEND")
              (progn
               (if (= (cdr (assoc '0 llist)) "VERTEX")
                  (progn
                   (if x21
                      (setq x21 (min x21 (cadr (assoc '10 llist))))
                      (setq x21 (cadr (assoc '10 llist)))
                   )
                   (if x22
                      (setq x22 (max x22 (cadr (assoc '10 llist))))
                      (setq x22 (cadr (assoc '10 llist)))
                   )
                   (if y21
                      (setq y21 (min y21 (cadr (cdr (assoc '10 llist)))))
                      (setq y21 (cadr (cdr (assoc '10 llist))))
                   )
                   (if y22
                      (setq y22 (max y22 (cadr (cdr (assoc '10 llist)))))
                      (setq y22 (cadr (cdr (assoc '10 llist))))
                   )
                  )
               )
               (setq subent (entnext subent))
               (setq llist (entget subent))
              )
           )
           (command "ERASE" ento "")
           (setq wdwpt1 (strcat (rtos x21) "," (rtos y21)))
           (setq wdwpt2 (strcat (rtos x22) "," (rtos y22)))
           (command "SELECT" "C" wdwpt1 wdwpt2 "")
          )
       )
      )
   )
   (if (and x11 x12 y11 y12 x21 x22 y21 y22)
      (progn
       (if (and (< (abs (- x11 x21)) 0.001) (< (abs (- x12 x22)) 0.001))
          ;; two windows aligned vertically
          (progn
           (setq tx1 x11)
           (setq tx2 x22)
           (setq ty1 (min y11 y21))
           (setq ty2 (max y12 y22))
           (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty1)))
           (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
           (command "erase" "W" wdwpt1 wdwpt2 "")
           (setq wdwpt2 (strcat (rtos tx1) "," (rtos ty2)))
           (command "line" wdwpt1 wdwpt2 "")
           (setq ent1 (ssget "L"))
           (setq ent1 (ssname ent1 0))
           (setq wdwpt1 (strcat (rtos tx2) "," (rtos ty1)))
           (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
           (command "line" wdwpt1 wdwpt2 "")
           (setq ent2 (ssget "L"))
           (setq ent2 (ssname ent2 0))
           (setq wdwpt1 (strcat (rtos (+ tx1 0.01)) "," (rtos (+ ty1 0.01))))
           (setq wdwpt2 (strcat (rtos (+ tx1 0.01)) "," (rtos (- ty2 0.01))))
           (command "trim" ent1 ent2 "" "F" wdwpt1 wdwpt2 "" "")
           (command "erase" ent1 ent2 "")
           (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty1)))
           (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
           (command "select" "C" wdwpt1 wdwpt2 "")
           ;; do trim
          )
          (if (and (< (abs (- y11 y21)) 0.001) (< (abs (- y12 y22)) 0.001))
             ;; two windows aligned horizontally
             (progn
              (setq tx1 (min x11 x21))
              (setq tx2 (max x12 x22))
              (setq ty1 y11)
              (setq ty2 y12)
              (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty1)))
              (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
              (command "erase" "W" wdwpt1 wdwpt2 "")
              (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty1)))
              (command "line" wdwpt1 wdwpt2 "")
              (setq ent1 (ssget "L"))
              (setq ent1 (ssname ent1 0))
              (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty2)))
              (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
              (command "line" wdwpt1 wdwpt2 "")
              (setq ent2 (ssget "L"))
              (setq ent2 (ssname ent2 0))
              (setq wdwpt1 (strcat (rtos (+ tx1 0.01)) "," (rtos (+ ty1 0.01))))
              (setq wdwpt2 (strcat (rtos (- tx2 0.01)) "," (rtos (+ ty1 0.01))))
              (command "trim" ent1 ent2 "" "F" wdwpt1 wdwpt2 "" "")
              (command "erase" ent1 ent2 "")
              (setq wdwpt1 (strcat (rtos tx1) "," (rtos ty1)))
              (setq wdwpt2 (strcat (rtos tx2) "," (rtos ty2)))
              (command "select" "C" wdwpt1 wdwpt2 "")
             )
             (write-line "\nWindows cannot be merged")
          )
       )
      )
  )
  (princ)
) ;; defun






(defun C:WDWELE (/ SEL LAY)
  (setq SEL " ")
  (setvar "cmdecho" 0)
  (setq LAY (getvar "clayer"))
  (while SEL
    (initget "Grouting Frame SAsh fiXed Couple SPlit Join Undo")
    (setq SEL (getkword (strcat "\nGrouting(" (itoa GROUT)
;;                                ")/Section"         ;;(itoa (* SECTW 2))
                                "/Frame/SAsh/fiXed"      ;;(itoa SASHW)
                                "/Couple"
                                "/SPlit"
                                "/Join"
                                "/Undo : ")))
    (cond
      ((= SEL "Grouting") (C:GROUT))
;;      ((= SEL "Section") (C:SECTW))
      ((= SEL "Frame") (C:FRAME))
      ((= SEL "SAsh") (C:SASH))
      ((= SEL "fiXed") (C:FIXED))
      ((= SEL "Couple") (C:COUPLE))
      ((= SEL "SPlit") (C:SPLIT))
      ((= SEL "Join") (C:JOIN))
      ((= SEL "Undo") (command "U"))
    )
  )
  (princ)
)