home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 15
/
BUGCD1998_06.ISO
/
aplic
/
felixcad
/
fcaddata.z
/
FLX_QLAY.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1996-09-30
|
12KB
|
314 lines
;;; FLX_QLAY.LSP
;;; ===========================================================
;;; Provided for FelixCAD
;;; Created: Dec 20, 1995 / dn
;;; Modified: Sep 29, 1996 / vp
;;; ===========================================================
;;; Commands: QLAYER
;;; Quick layer control by selecting reference element
;;; ===========================================================
(defun FLX_QLAYER ( / prt_list l1 l2 l3 selstrlist mod lst el
lstlay change_how GETAUSLAY GETFRLAY
TOGGLE_ALL_LAY LAYERCONTROL_OK
CHANGELAY DlgInit)
(FLX_FUNC_INIT)
;;; Prompt List
(setq prt_list (list
"Please select only ONE layer name!" ;;;@ 0
"Set Layer" ;;;@ 1 Title Alert
"Layer does not exist: " ;;;@2
"\nLayer unlocked: " ;;;@3
"\nLayer thawed: " ;;;@4
"\nLayer locked: " ;;;@5
"\nLayer freezed: " ;;;@6
"New current layer: " ;;;@7
"Turn off the CURRENT layer?" ;;;@8
"\nLayer turned off: " ;;;@9
"\nLayer turned off: " ;;;@10
"\nLayer already turned off: " ;;;@11
"\nLayer turned on: " ;;;@12
"\nLayer already turned on: " ;;;@13
"The current layer cannot be freezed!" ;;;@14
"On..." ;;;@15 # initget
"Thaw..." ;;;@16 # initget
"Select reference entity to set layer: " ;;;@17
"Select reference entity to turn layer off: " ;;;@18
"Select reference entity to lock layer: " ;;;@19
"Select reference entity to freeze layer: " ;;;@20
"Alert" ;;;@21
"Select reference entity to unlock layer: " ;;;@22
"Off Lock Freeze Unlock On... Thaw..." ;;;@23 # initget
"Off" ;;;@24 # initget
"Lock" ;;;@25 # initget
"Freeze" ;;;@26 # initget
"Unlock" ;;;@27 # initget
"New current layer: " ;;;@28
))
(if FLX_XLANGUAGE (FLX_XLANGUAGE "_qlay" nil))
;;;---------------------------------------------------------------------
;;; Functions for Layer Dialog
;;;---------------------------------------------------------------------
(defun GETAUSLAY( / x tmp)
(setq x 0 ret "")
(while (< x (length lstlay))
(setq tmp (tblsearch "LAYER" (nth x lstlay)))
(if (and tmp (< (cdr (assoc 62 tmp)) 0))
(setq ret (strcat ret (symbtos x) " "))
)
(setq x (+ x 1))
)
(setq ret ret)
)
;;;---------------------------------------------------------------------
(defun GETFRLAY()
(setq x 0 ret "")
(while (< x (length lstlay))
(setq tmp (tblsearch "LAYER" (nth x lstlay)))
(IF (and tmp (= (logand 1 (cdr (assoc 70 tmp))) 1))
(setq ret (strcat ret (symbtos x) " "))
)
(setq x (+ x 1))
)
(setq ret ret)
)
;;;---------------------------------------------------------------------
(defun TOGGLE_ALL_LAY ( / x s)
(if (= $value "1")
(progn
(setq x 0 s "")
(while (<= x (length lstlay))
(setq s (strcat s (symbtos x) " "))
(setq x (+ x 1))
)
(Dlg_TileSet "layer" s)
)
(Dlg_ListStart "layer")
(mapcar 'Dlg_ListAdd lstlay)
(Dlg_ListEnd)
)
)
;;;---------------------------------------------------------------------
(defun LAYERCONTROL_OK ()
(if (= (Dlg_TileGet "L_set") "1") (setq mod 0))
(if (= (Dlg_TileGet "L_off") "1") (setq mod 1))
(if (= (Dlg_TileGet "L_lock") "1") (setq mod 2))
(if (= (Dlg_TileGet "L_freeze") "1") (setq mod 3))
(if (= (Dlg_TileGet "L_on") "1") (setq mod 4))
(if (= (Dlg_TileGet "L_free") "1") (setq mod 5))
(if (= (Dlg_TileGet "L_thaw") "1") (setq mod 6))
(if (setq lst (Dlg_TileGet "layer"))
(setq lst (read (strcat "(" lst ")" )))
)
(if (AND (> (length lst) 1) (= mod 0))
(ALERT
(nth 0 prt_list) ;;;@"Please select only ONE layer name!"
(nth 1 prt_list) ;;;@"Set Layer"
"EXCLAMATION"
)
(progn
(if (AND (= (length lst) 0)(= mod 1))
(setq lst (list (getvar "CLAYER")))
)
(Dlg_DialogDone)
)
)
)
;;;-------------------------------------------------------------------
;;; CHANGE LAYER PROPERTIES
;;; lay: Layer name
;;; change_how: 0=set 1=off 2=lock 3=freeze 4=on 5=free 6=thaw
;;;-------------------------------------------------------------------
(defun CHANGELAY (lay change_how / tmp fr sp x melde)
(if (not (setq tmp (tblsearch "LAYER" lay)))
(ALERT
(strcat (nth 2 prt_list) lay) ;;;@"Layer does not exist: "
(nth 21 prt_list)
"EXCLAMATION"
)
(progn
(setq sp (logand 4 (cdr (assoc 70 tmp))))
(setq fr (logand 1 (cdr (assoc 70 tmp))))
(if (= change_how 5) (setq sp 0 melde (nth 3 prt_list))) ;;;@\nLayer unlocked:
(if (= change_how 6) (setq fr 0 melde (nth 4 prt_list))) ;;;@\nLayer thawed:
(if (= change_how 2) (setq sp 4 melde (nth 5 prt_list))) ;;;@\nLayer locked:
(if (= change_how 3) (setq fr 1 melde (nth 6 prt_list))) ;;;@\nLayer freezed:
(cond
((= change_how 0)
(setvar "CLAYER" lay)
(princ (nth 7 prt_list)) ;;;@\nNew current layer:
(princ lay)
)
((= change_how 1) ;;; Off
(if (> (setq x (cdr (assoc 62 tmp))) 0)
(progn
(setq x (* x -1))
(setq tmp (subst (cons 62 x) (assoc 62 tmp) tmp))
(if (= (strcase lay) (getvar "CLAYER"))
(if (ALERT
(nth 8 prt_list) ;;;@Turn off the CURRENT layer?
(nth 21 prt_list) ;;;@Alert
"QUESTION"
)
(if (tblmod tmp) (princ (strcat
(nth 9 prt_list) ;;;@\nLayer turned off:
lay
)))
)
(if (tblmod tmp) (princ (strcat
(nth 10 prt_list) ;;;@\nLayer turned off:
lay
)))
)
)
(princ (strcat
(nth 11 prt_list) ;;;@\nLayer already turned off:
lay
))
)
) ;;; 1
((= change_how 4) ;;; On
(if (< (setq x (cdr (assoc 62 tmp))) 0)
(progn
(setq x (* x -1))
(setq tmp (subst (cons 62 x) (assoc 62 tmp) tmp))
(if (tblmod tmp) (princ (strcat
(nth 12 prt_list) ;;;@\nLayer turned on:
lay
)))
)
(princ (strcat
(nth 13 prt_list) ;;;@\nLayer already turned on:
lay
))
)
) ;;; 4
(T ;;; FREI/SP/FR/TAU
(setq x (logior sp fr (if (= lay "0") 64 0)))
(setq tmp (subst (cons 70 x) (assoc 70 tmp) tmp))
(if (and (= lay (getvar "CLAYER"))(= fr 1))
(ALERT
(nth 14 prt_list) ;;;@The current layer cannot be freezed!
(nth 21 prt_list) ;;;@Alert
"EXCLAMATION"
)
(if (tblmod tmp)(princ (strcat melde lay)))
)
) ;;; T
) ;;; cond
)
)
(princ)
)
;;;---------------------------------------------------------------------
(defun DlgInit ( / s1)
(if FLX$WIN95 (foreach n
'("IDCANCEL" "IDOK" "IDHELP"
"layer" "EditCurr" "LayControl" "L_set" "SelectAll"
"L_on" "L_off" "L_free" "L_lock" "L_thaw" "L_freeze"
"Static1" "Static2" "Static3" "Static4")
(Dlg_TileSetFont n 2)
))
(Dlg_TileAction "IDOK" "(LAYERCONTROL_OK)")
(Dlg_TileAction "IDCANCEL" "(setq lst nil mod nil)(Dlg_DialogDone)")
(setq lstlay '())
(if (setq s1 (tblnext "LAYER" T))
(progn
(setq lstlay (cons (cdr (assoc 2 s1)) lstlay))
(while (setq s1 (tblnext "LAYER"))
(setq lstlay (append lstlay (list (cdr (assoc 2 s1)))))
)
)
)
(Dlg_ListStart "layer")
(mapcar 'Dlg_ListAdd lstlay)
(Dlg_ListEnd)
(cond
((= l1 (nth 15 prt_list)) ;;;@On...
(Dlg_TileSet "L_on" "1")
(Dlg_TileSet "layer" (GETAUSLAY))
)
((= l1 (nth 16 prt_list)) ;;;@Thaw...
(Dlg_TileSet "L_thaw" "1")
(Dlg_TileSet "layer" (GETFRLAY))
)
((= mod 0) (Dlg_TileSet "L_set" "1"))
((= mod 1) (Dlg_TileSet "L_off" "1"))
((= mod 2) (Dlg_TileSet "L_lock" "1"))
((= mod 3) (Dlg_TileSet "L_freeze" "1"))
((= mod 4) (Dlg_TileSet "L_on" "1"))
((= mod 5) (Dlg_TileSet "L_free" "1"))
((= mod 6) (Dlg_TileSet "L_thaw" "1"))
)
(Dlg_TileSet "EditCurr" (getvar "CLAYER"))
(Dlg_TileAction "layer" "(if (= $reason 4)(LAYERCONTROL_OK))")
(Dlg_TileAction "SelectAll" "(TOGGLE_ALL_LAY)")
) ;DlgInit
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; MAIN
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(setq mod 0) ;;; Mode 0 = Set layer
(setq selstrlist (list
(nth 17 prt_list) ;;;@\nSelect reference entity to set layer:
(nth 18 prt_list) ;;;@\nSelect reference entity to turn layer off:
(nth 19 prt_list) ;;;@\nSelect reference entity to lock layer:
(nth 20 prt_list) ;;;@\nSelect reference entity to freeze layer:
(nth 21 prt_list) ;;;@""
(nth 22 prt_list) ;;;@\nSelect reference entity to unlock layer:
))
(while (not l1)
(initget 256 (nth 23 prt_list)) ;;;@Off Lock Freeze Unlock On... Thaw...
(setq l1 (entsel (nth mod selstrlist)))
;;; If no entity has been selected, a dialog box comes up with a layer list.
(cond
((= l1 (nth 24 prt_list)) ;;;@Off
(setq mod 1 l1 nil)
)
((= l1 (nth 25 prt_list)) ;;;@Lock
(setq mod 2 l1 nil)
)
((= l1 (nth 26 prt_list)) ;;;@Freeze
(setq mod 3 l1 nil)
)
((= l1 (nth 27 prt_list)) ;;;@Unlock
(setq mod 5 l1 nil)
)
((= (type l1) 'LIST) ;;; Reference entity picked...
(princ)
)
(T
(if (FLX_DLGDSP "flx_dlg" "LayerSet" "(princ)" "(DlgInit)") (princ) (exit) )
(setq l1 T)
)
) ; cond
) ; while
(if (= (type l1) 'LIST) ;;; IF Reference entity has bee picked...
(progn
(setq l2 (entget (car l1)))
(setq l3 (cdr (assoc 8 l2)))
(cond
((= mod 0)
(setvar "CLAYER" l3)
(princ (nth 28 prt_list)) ;;;@\nNew current layer:
(princ l3)
)
(T (CHANGELAY l3 mod))
)
)
(progn ;;; ELSE via dialog !
(if (AND lst mod) (foreach el lst (CHANGELAY (nth el lstlay) mod)))
)
)
(FLX_FUNC_EXIT)
(princ)
)
(princ)