home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_XPLD.LSP < prev    next >
Lisp/Scheme  |  1996-09-30  |  6KB  |  142 lines
  1. ;;; FLX_XPLD.LSP
  2. ;;; ==============================================================================
  3. ;;; (C)opyright Felix Computer Aided Technologies GmbH 1995-96
  4. ;;; ==============================================================================
  5. ;;; Created: Feb 26, 1996 vp
  6. ;;; Updated: Sep 29, 1996 vp
  7. ;;; ==============================================================================
  8. ;;; XPLODE: Filtered Explode Dialog
  9. ;;; The command is located in the pull-down menu EDIT of fcad.mnu
  10. ;;; ==============================================================================
  11. ;;; This file is called by FLX_MAIN.LSP
  12. ;;; Global Variables:
  13. ;;; - Check Box Settings are stored in the variable FLX$EXPLODELIST
  14. ;;; ==============================================================================
  15.  
  16. (defun FLX_XPLODE( / prt_list FLX_XPLD DlgInit 
  17.                      cmde ss1 dialog_ok s1 s2 s3 s4 tmp el l1)
  18.  
  19.   ;;; Prompt List:
  20.  
  21.   (setq prt_list (list
  22.           "Cannot explode parts with different XYZ scale!"
  23.           "entities exploded."
  24.           "No entities exploded."
  25.           "No entity in current drawing!"
  26.           "Alert"
  27.   ))
  28.   (if FLX_XLANGUAGE (FLX_XLANGUAGE "_xpld" nil))
  29.   
  30.   ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  31.   (defun FLX_XPLD (s1 ss1 / s1 ss1 ss2 i1 i2 f3 f4 el1)  ;;; s1 = xplode mode 
  32.          (setq i1 (sslength ss1)
  33.                i2 0
  34.                f4 T       ;;; f4 = flag to display message ...
  35.                ss2 (ssadd)
  36.          )
  37.          (while (< i2 i1)
  38.             (setq el1 (entget (setq e1 (ssname ss1 i2)))
  39.                      i2 (1+ i2) f3 nil
  40.             )
  41.              (if (member "D" s1) 
  42.               (if (= (cdr (assoc 0 el1)) "DIMENSION")(setq f3 T))
  43.              ) 
  44.              (if (member "B" s1)
  45.               (if (and (= (cdr (assoc 0 el1)) "INSERT")
  46.                        (/= (substr (cdr (assoc 2 el1)) 1 2) "*X")
  47.                   ) 
  48.                   (setq f3 T)
  49.               )
  50.              )
  51.              (if (member "H" s1) 
  52.                (if (and (= (cdr (assoc 0 el1)) "INSERT")
  53.                         (= (substr (cdr (assoc 2 el1)) 1 2) "*X")
  54.                    ) 
  55.                    (setq f3 T)
  56.                )
  57.              )        
  58.              (if (member "P" s1)
  59.                (if (= (cdr (assoc 0 el1)) "POLYLINE")
  60.                    (setq f3 T)
  61.                )
  62.              ) 
  63.              (if (= (cdr (assoc 0 el1)) "INSERT")
  64.                (if (or
  65.                        (/= (cdr (assoc 41 el1)) (cdr (assoc 42 el1)))
  66.                        (/= (cdr (assoc 41 el1)) (cdr (assoc 43 el1)))
  67.                        (/= (cdr (assoc 42 el1)) (cdr (assoc 43 el1)))
  68.                    )
  69.                    (progn
  70.                     (setq f3 nil)
  71.                     (if f4 (progn
  72.                         (setq f4 nil)
  73.                         (princ (nth 0 prt_list)) ;;;@Cannot explode parts with different XYZ scale!
  74.                     ))
  75.                    )
  76.              )
  77.            )
  78.            (if f3 (ssadd e1 ss2))
  79.      ) ; while
  80.      (setvar "CMDECHO" 0)
  81.      (if (and ss2 (> (sslength ss2) 0) )
  82.          (progn
  83.              (command ".EXPLODE" ss2 "") 
  84.              (princ (strcat 
  85.                 (symbtos (sslength ss2)) " " (nth 1 prt_list)
  86.              )) ;;;@entities exploded. 
  87.           )
  88.           (princ  (nth 2 prt_list) ) ;;;@No entities exploded.
  89.      ) 
  90.   )
  91.   ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  92.   (defun DlgInit ( / n)
  93.       (if FLX$WIN95 (foreach n 
  94.            '("IDCANCEL" "IDOK" "IDHELP"
  95.              "Check1" "Check2" "Check3" "Check4" "Button1" "GroupBox1")
  96.            (Dlg_TileSetFont n 2)
  97.       ))
  98.       (if (member "B" FLX$EXPLODELIST) (progn (setq s1 T)(Dlg_TileSet "Check1" "1")))
  99.       (if (member "P" FLX$EXPLODELIST) (progn (setq s2 T)(Dlg_TileSet "Check2" "1")))
  100.       (if (member "H" FLX$EXPLODELIST) (progn (setq s3 T)(Dlg_TileSet "Check3" "1")))
  101.       (if (member "D" FLX$EXPLODELIST) (progn (setq s4 T)(Dlg_TileSet "Check4" "1")))
  102.       (Dlg_TileAction "Check1" "(setq s1 (if (= $value \"1\") T nil))")  ;;; Part/Block
  103.       (Dlg_TileAction "Check2" "(setq s2 (if (= $value \"1\") T nil))")  ;;; Polylines
  104.       (Dlg_TileAction "Check3" "(setq s3 (if (= $value \"1\") T nil))")  ;;; Cross-Hatching
  105.       (Dlg_TileAction "Check4" "(setq s4 (if (= $value \"1\") T nil))")  ;;; Dimension
  106.       (setq tmp '("Check1" "Check2" "Check3" "Check4"))
  107.       (Dlg_TileAction "Button1"
  108.           "(foreach el tmp (Dlg_TileSet el \"1\"))(setq s1 T s2 T s3 T s4 T)" ;;; All Types 
  109.       ) 
  110.       (Dlg_TileAction "IDOK" "(setq dialog_ok T)(Dlg_DialogDone)")
  111.       (Dlg_TileAction "IDCANCEL" "(setq dialog_ok nil)(Dlg_DialogDone)")
  112.   )
  113.  
  114.   ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  115.   ;;; Main
  116.  
  117.   (FLX_FUNC_INIT)  ;;; Global Init Function and Error Handler
  118.   (if (not entlast) (progn
  119.       (alert (nth 3 prt_list)(nth 4 prt_list) "EXCLAMATION")
  120.       (exit)
  121.   ))
  122.   (if (not FLX$EXPLODELIST) (setq FLX$EXPLODELIST (list "B"))) ;;; "P" "H" "D"
  123.   (if (FLX_DLGDSP "flx_dlg" "EXPLODE" "(princ)" "(DlgInit)") (princ) (exit) )
  124.   (if dialog_ok (progn
  125.       (setq l1 nil)
  126.       (if s1 (setq l1 (cons "B" l1)))
  127.       (if s2 (setq l1 (cons "P" l1)))
  128.       (if s3 (setq l1 (cons "H" l1)))
  129.       (if s4 (setq l1 (cons "D" l1)))
  130.       (setq FLX$EXPLODELIST l1)
  131.       ;;; if xplode mode has been specified:
  132.       (if (> (length l1) 0) (progn
  133.             (setq ss1 (ssget))
  134.             (if ss1 (FLX_XPLD l1 ss1) )
  135.       ))
  136.   ))
  137.   (FLX_FUNC_EXIT)
  138.   (princ) 
  139. )
  140.  
  141. (princ)
  142.