home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_DIM.LSP < prev    next >
Lisp/Scheme  |  1996-09-30  |  4KB  |  126 lines
  1. ;;; FLX_DIM.LSP
  2. ;;; ============================================================================
  3. ;;; Provided by Felix Computer Aided Technologies GmbH 1995-96
  4. ;;; Created: Jan 20, 1996 / vp
  5. ;;; Changed: Sept 29, 1996 / vp
  6. ;;; ============================================================================
  7.  
  8. (defun FLX_DIMDIALOG (dlg_file dlg_id / dlg_file dlg_id DIM_INIT cmd flag
  9.                                         pal1 pal2 cmd_list help_keyword)
  10.  
  11.   (setq pal1 "fc_dim.mnp" pal2 "fc_edim.mnp")
  12.  
  13.   (setq help_keyword "Dimensioning Summary")
  14.   (setq cmd_list (list
  15.        (list "DimHor"  ".DIMHOR")
  16.        (list "DimVer"  ".DIMVER")
  17.        (list "DimRot"  ".DIMROT")
  18.        (list "DimAli"  ".DIMALI")
  19.        (list "DimSer"  ".DIMSER")
  20.        (list "DimCon"  ".DIMCON")
  21.        (list "DimBas"  ".DIMBAS")
  22.        (list "DimDia"  ".DIMDIA")
  23.        (list "DimRad"  ".DIMRAD")
  24.        (list "DimCent" ".DIMCENT")
  25.        (list "DimA3P"  ".DIMA3P")
  26.        (list "DimA4P"  ".DIMA4P")
  27.        (list "DimOrd"  ".DIMORD")
  28.        (list "DimUpd"  ".DIMUPD")
  29.        (list "DimObl"  ".DIMOBL")
  30.        (list "DimTnew"  ".DIMTNEW")
  31.        (list "DimTmove" ".DIMTMOVE")
  32.        (list "DimThome" ".DIMTHOME")
  33.        (list "DimTrot"  ".DIMTROT")
  34.        (list "DimType"  ".DIMTYPE")
  35.   ))
  36.   (if FLX_XLANGUAGE (FLX_XLANGUAGE "_dim" "_dimdialog"))
  37.   ;;; --------------------------------------------------
  38.  
  39.   (if (> (getvar "ACTDB") -1) (progn
  40.    (defun *ERROR* (msg) (setvar "CMDECHO" 1)(setq *ERROR* nil)(princ)) 
  41.    ;----------------------------------------------------------------------------
  42.    (defun DIM_INIT ( / n n1)
  43.       (if FLX$WIN95 (foreach n '("IDCANCEL" "IDHELP")(Dlg_TileSetFont n 2)))
  44.       (foreach n1 cmd_list
  45.          (Dlg_TileAction
  46.             (car n1)
  47.             (strcat "(setq cmd \"" (cadr n1) "\")(Dlg_DialogDone)")
  48.          )
  49.       )
  50.       (Dlg_TileAction "DimDrawPal" "(setq cmd \"DIMDRAWPAL\")(Dlg_DialogDone)")
  51.       (Dlg_TileAction "DimEditPal" "(setq cmd \"DIMEDITPAL\")(Dlg_DialogDone)")
  52.       (Dlg_TileAction "IDCANCEL"   "(setq cmd nil)(Dlg_DialogDone)")
  53.       (Dlg_TileAction "IDHELP"     "(help help_keyword)")
  54.    )
  55.    ;----------------------------------------------------------------------------
  56.    (setq flag T)
  57.    (while flag
  58.       (setq cmd nil)
  59.       (if (FLX_DLGDSP dlg_file dlg_id "(princ)" "(Dim_Init)") (princ) (exit))
  60.       (if cmd 
  61.         (progn
  62.           (setvar "CMDECHO" 1)
  63.           (cond
  64.             ((= cmd "DIMDRAWPAL") (PALNEXT pal1)(setq flag nil)) ;;;fc_dim.mnp
  65.             ((= cmd "DIMEDITPAL") (PALNEXT pal2)(setq flag nil)) ;;;fc_edim.mnp
  66.             ((= cmd ".DIMTYPE")   (command ".DIMTYPE"))   ;;; DIMTYPE dialog box
  67.             ((= cmd ".BEMTYP")    (command ".BEMTYP"))    ;;; " (german command) 
  68.             ;;; TRUE: princ command name and execute command
  69.             (T
  70.                (princ (substr cmd 2))(terpri)
  71.                (command cmd)(setq flag nil)
  72.             ) 
  73.           ) ; cond
  74.         )
  75.         (setq flag nil)
  76.       )
  77.    )
  78.    (setq *ERROR* nil) 
  79.  )) ;;; ACTDB end
  80. )
  81.  
  82. ; -------------------------------------------------------------------------------
  83.  
  84. (defun FLX_DIMREST ( / e1 elst dimtyp prt_lst)
  85.  
  86.     (setq prt_list (list
  87.           "Set dimension type by reference dimension.\n"
  88.           "Dimension type "
  89.           " set!"
  90.           "No style assigned to that dimension!"
  91.           "No dimension selected!"
  92.     )) 
  93.     (if FLX_XLANGUAGE (FLX_XLANGUAGE "_dim" "_dimrest"))
  94.  
  95.     (FLX_FUNC_INIT)
  96.     (princ (nth 0 prt_list))
  97.     (if (setq e1 (entsel))
  98.       (progn
  99.         (setq elst (entget (car e1)))
  100.         (if (= (cdr (assoc 0 elst)) "DIMENSION")
  101.            (progn
  102.              (if (and (/= (setq dimtyp (cdr (assoc 3 elst))) "*UNNAMED") 
  103.                       (assoc 3 elst)
  104.                  )
  105.                   (progn
  106.                     (tblset "DIMSTYLE" dimtyp)
  107.                     (princ (strcat 
  108.                        (nth 1 prt_list) dimtyp (nth 2 prt_list) 
  109.                     ))
  110.                    )
  111.                    (princ (nth 3 prt_list))
  112.                )
  113.              )
  114.           )
  115.       )
  116.       (princ (nth 4 prt_list) )
  117.     )
  118.     (FLX_FUNC_EXIT)
  119.     (princ)
  120. )
  121.  
  122. ; -------------------------------------------------------------------------------
  123.  
  124. (princ)
  125.  
  126.