home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 15
/
BUGCD1998_06.ISO
/
aplic
/
felixcad
/
fcaddata.z
/
FLX_SETP.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1996-09-30
|
7KB
|
167 lines
;;; FLX_SETP.LSP
;;; ================================================================
;;; Drawing Setup Dialog for FelixCAD
;;; ================================================================
;;; Created: Sept 01, 1996 / vp
;;; Changed: Sept 29, 1996 / vp
;;; ================================================================
;;; Note: This routine is called by FLX_MAIN.LSP
;;; ================================================================
(defun FLX_SETUP ( / DlgInit prefix n i lun_lst aun_lst
auprec luprec aunits lunits angdir)
(defun *error*(msg)
(setq *error* nil)
(princ)
)
(setq prefix (if (= (getvar "ACTDB") -1) "DEF" ""))
(setq lun_lst (list
"Decimal" ; 2 -> 0
"Fractional" ; 5 -> 1
"Architectural (feet and inches)" ; 4 -> 2
"Engineering (feet and inches)" ; 3 -> 3
"Scientific (decimal)" ; 1 -> 4
))
(setq aun_lst (list
"Decimal Degrees" ; 0
"Degrees-minutes-seconds" ; 1
"Grads" ; 2
"Radians" ; 3
"Surveyor's Units" ; 4
))
(defun Cv_lunits_var ( / n i)
(setq n (getvar (strcat prefix "LUNITS")))
(setq i (cond
((= n 2) 0) ((= n 5) 1) ((= n 3) 3) ((= n 4) 2) ((= n 1) 4)
))
)
(defun Cv_lunits_lst ( / n i)
(setq n lunits)
(setq i (cond
((= n 0) 2) ((= n 1) 5) ((= n 3) 3) ((= n 2) 4) ((= n 4) 1)
))
)
;;; get current local system variables
(setq luprec (getvar (strcat prefix "LUPREC")))
(setq auprec (getvar (strcat prefix "AUPREC")))
(setq lunits (Cv_lunits_var))
(setq aunits (getvar (strcat prefix "AUNITS")))
(setq angdir (getvar (strcat prefix "ANGDIR")))
(setq angbase (getvar (strcat prefix "ANGBASE")))
;;; ---------------------------------------------------------------------------------
;;; Main dialog
;;; ---------------------------------------------------------------------------------
(defun DlgInit () ;;; ### ( / FillList UpdateLuprecList UpdateAuprecList Example cbox lstn val)
(if FLX$WIN95 (foreach n
'("IDCANCEL" "IDOK" "IDHELP" "GroupBox1" "GroupBox2" "Button1" "Radio1" "Radio2"
"ComboBox1" "ComboBox2" "ComboBox3" "ComboBox4"
"Static1" "Static2" "Static3" "Static4" "Static5" "Static6" "Static7" "Static8"
"Edit1" "Edit2" "Edit3" "Edit4" "Example1" "Example2" "Example3"
)
(Dlg_TileSetFont n 2)
))
(defun FillList (cbox lstn val)
(Dlg_ListStart cbox)(mapcar 'Dlg_ListAdd lstn)(Dlg_ListEnd)
(Dlg_TileSet cbox (nth val lstn))
)
(defun UpdateLuprecList()
(setq lup_lst (if (or (= lunits 1)(= lunits 2))
(list "0" "1/2" "1/4" "1/8" "1/16" "1/32" "1/64" "1/128" "1/256")
(list "0" "0.1" "0.01" "0.001" "0.0001" "0.00001" "0.000001"
"0.0000001" "0.00000001")
))
(FillList "ComboBox2" lup_lst luprec)
)
(defun UpdateAuprecList()
(setq aup_lst
(list "0" "0.1" "0.01" "0.001" "0.0001" "0.00001" "0.000001"
"0.0000001" "0.00000001")
)
(FillList "ComboBox4" aup_lst auprec)
)
(defun Example()
(Dlg_TileSet "Example1" (rtos 123.45678901234 (Cv_lunits_lst) luprec))
(Dlg_TileSet "Example2" (angtos (/ pi 4.00) aunits auprec))
(Dlg_TileSet "Example3" (angtos (/ pi 5.10) aunits auprec))
(Dlg_TileSet "Static8" (angtos angbase aunits auprec))
)
;;; Set dialog controls
(Example)
(FillList "ComboBox1" lun_lst lunits)
(UpdateLuprecList)
(FillList "ComboBox3" aun_lst aunits)
(UpdateAuprecList)
(if (= angdir 0) (Dlg_TileSet "Radio1" "1") (Dlg_TileSet "Radio2" "1") )
;;; Reactors to dialog events
(Dlg_TileAction "ComboBox1"
"(setq lunits (- 5 (length (member $value lun_lst))))(UpdateLuprecList)(example)"
)
(Dlg_TileAction "ComboBox2"
"(setq luprec (- 9 (length (member $value lup_lst))))(example)"
)
(Dlg_TileAction "ComboBox3"
"(setq aunits (- 5 (length (member $value aun_lst))))(UpdateAuprecList)(example)"
)
(Dlg_TileAction "ComboBox4"
"(setq auprec (- 9 (length (member $value aup_lst))))(example)"
)
(Dlg_TileAction "Radio1" "(setq angdir 0)")
(Dlg_TileAction "Radio2" "(setq angdir 1)")
(Dlg_TileAction "Button1" "(Ang0direction)(example)")
(Dlg_TileAction "IDOK" "(setq dialog_ok T)(Dlg_DialogDone)")
(Dlg_TileAction "IDCANCEL" "(setq dialog_ok nil)(Dlg_DialogDone)")
)
;;; ---------------------------------------------------------------------------------
;;; Sub-dialog to set Angle 0 directions
;;; ---------------------------------------------------------------------------------
(defun Ang0direction( / DlgInit2 dialog_ok current_angbase example2)
(defun DlgInit2()
(if FLX$WIN95 (foreach n
'("IDCANCEL" "IDOK" "IDHELP" "GroupBox1"
"Radio1" "Radio2" "Radio3" "Radio4"
"Static1" "Static2" "Static3" "Static4" "Static5" "Static6"
)
(Dlg_TileSetFont n 2)
))
(cond
((= angbase 0.0) (Dlg_TileSet "Radio1" "1"))
((= angbase (/ pi 2.0)) (Dlg_TileSet "Radio2" "1"))
((= angbase pi) (Dlg_TileSet "Radio3" "1"))
((= angbase (* pi 1.5)) (Dlg_TileSet "Radio4" "1"))
)
(defun Example2 ()
(Dlg_TileSet "Static2" (angtos angbase aunits auprec))
)
(Dlg_TileSet "Static2" (angtos angbase aunits auprec))
(Dlg_TileAction "Radio1" "(setq angbase 0.00)(example2)")
(Dlg_TileAction "Radio2" "(setq angbase (/ pi 2.00))(example2)")
(Dlg_TileAction "Radio3" "(setq angbase pi)(example2)")
(Dlg_TileAction "Radio4" "(setq angbase (* pi 1.50))(example2)")
(Dlg_TileAction "IDOK" "(setq dialog_ok T)(Dlg_DialogDone)")
(Dlg_TileAction "IDCANCEL" "(setq dialog_ok nil)(Dlg_DialogDone)")
)
(setq current_angbase angbase)
(if (FLX_DLGDSP "flx_dlg" "BEARINGS" "(princ)" "(DlgInit2)") (princ)(exit))
(setq angbase (if dialog_ok angbase current_angbase))
)
;;; ---------------------------------------------------------------------------------
;;; MAIN (continued)
;;; ---------------------------------------------------------------------------------
(if (FLX_DLGDSP "flx_dlg" "SETUP" "(princ)" "(DlgInit)") (princ) (exit))
(if dialog_ok (progn
(setvar (strcat prefix "LUNITS") (cv_lunits_lst))
(setvar (strcat prefix "AUNITS") aunits)
(setvar (strcat prefix "LUPREC") luprec)
(setvar (strcat prefix "AUPREC") auprec)
(setvar (strcat prefix "ANGDIR") angdir)
(setvar (strcat prefix "ANGBASE") angbase)
))
(setq *error* nil)
(princ)
)
(princ)