home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SUPPORT / FILTER.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  88.2 KB  |  2,466 lines

  1. ; Next available MSG number is   117
  2. ; MODULE_ID FILTER_LSP_
  3. ;;;----------------------------------------------------------------------------
  4. ;;;    FILTER.LSP  Version 0.5
  5. ;;;
  6. ;;;    Copyright (C) 1991, 1992, 1993, 1994 by Autodesk, Inc.
  7. ;;;
  8. ;;;    Permission to use, copy, modify, and distribute this software
  9. ;;;    for any purpose and without fee is hereby granted, provided
  10. ;;;    that the above copyright notice appears in all copies and
  11. ;;;    that both that copyright notice and the limited warranty and
  12. ;;;    restricted rights notice below appear in all supporting
  13. ;;;    documentation.
  14. ;;;
  15. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
  16. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
  17. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
  18. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
  19. ;;;    UNINTERRUPTED OR ERROR FREE.
  20. ;;;
  21. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
  22. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
  23. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
  24. ;;;    (Rights in Technical Data and Computer Software), as applicable.
  25. ;;;
  26. ;;;.  
  27. ;;;----------------------------------------------------------------------------
  28. ;;;  DESCRIPTION
  29. ;;;
  30. ;;;  Dialogue front end to (ssget).  Allows customers to create, save and
  31. ;;;  apply filter lists for entity selection via a dialogue interface.
  32. ;;;  Uses FILTER.DCL.
  33. ;;;
  34. ;;;----------------------------------------------------------------------------
  35. ;;;
  36. ;;; Avoid (gc)s on load to improve load time.
  37. ;;;
  38. (defun do_alloc (/ old_allod new_alloc)
  39.   (setq old_alloc (alloc 2000) new_alloc (alloc 2000))
  40.   (expand (1+ (/ 11500 new_alloc)))
  41.   (alloc old_alloc)
  42. )
  43. (do_alloc)
  44. (setq do_alloc nil)
  45. ;;;
  46. ;;; ===========================================================================
  47. ;;; ===================== load-time error checking ============================
  48. ;;;
  49.  
  50.   (defun ai_abort (app msg)
  51.      (defun *error* (s)
  52.         (if old_error (setq *error* old_error))
  53.         (princ)
  54.      )
  55.      (if msg
  56.        (alert (strcat " Error en la aplicaci≤n: "
  57.                       app
  58.                       " \n\n  "
  59.                       msg
  60.                       "  \n"
  61.               )
  62.        )
  63.      )
  64.      (exit)
  65.   )
  66.  
  67. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  68. ;;; and then try to load it.
  69. ;;;
  70. ;;; If it can't be found or it can't be loaded, then abort the
  71. ;;; loading of this file immediately, preserving the (autoload)
  72. ;;; stub function.
  73.  
  74.   (cond
  75.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  76.  
  77.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  78.         (ai_abort "FILTER"
  79.                   (strcat "Imposible localizar archivo AI_UTILS.LSP"
  80.                           "\n Compruebe el directorio de soporte.")))
  81.  
  82.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  83.         (ai_abort "\nAplicando filtro a la selecci≤n.  " "Imposible cargar archivo AI_UTILS.LSP"))
  84.   )
  85.  
  86.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  87.       (ai_abort "\nAplicando filtro a la selecci≤n.  " nil)         ; a Nil <msg> supresses
  88.   )                                    ; ai_abort's alert box dialog.
  89.  
  90. ;;; ==================== end load-time operations ===========================
  91.  
  92. ;;;----------------------------------------------------------------------------
  93. ;;; The Main function.  Variables are initialised, and the dialogue box is
  94. ;;; prepared and activated.  A while loop is used to allow the dialogue box
  95. ;;; to be hidded for entity selection.
  96. ;;;----------------------------------------------------------------------------
  97. (defun c:filter(/ 
  98.              a                 edit_item         just_name      selection_list    
  99.              add_to_list       edit_this         label          single_table      
  100.              after_errno       enable_disable    lisp_error                   
  101.              all_lisp_list     entity_ename      lisp_pos       str1              
  102.              appid_str         entity_lisp       list1          str2              
  103.              bit_flag          entity_lisp_init  list_name      string            
  104.              c1                entity_lisp_list  list_str       str_name          
  105.              c2                entity_type       load_err       str_pos           
  106.              check_color       error_msg         load_log       str_val           
  107.              check_int         filter_main       lts            
  108.              clear_list        filter_err        make_list      table_item        
  109.              cmd               filter_gc         n              table_list        
  110.              cnum              filter_lisp_list  n1             table_match       
  111.              color_no          filter_list       name           table_name        
  112.              current_filter    filter_nfl        named_lists    temp              
  113.              current_line      filter_str_list   new_length     temp_lisp_list    
  114.              dcl_id            f_err             new_lisp       temp_list         
  115.              delete_list       gc_name           new_str        temp_ss           
  116.              filename                            nfl_lisp       temp_str          
  117.              group_0                             nfl_str        the_list          
  118.              group_8           globals           olderr         title             
  119.              group_10          good_value        op             update            
  120.              group_40                            ops_3          val               
  121.              group_50                            pat            value             
  122.              group_62                            pat_match      what_is_it        
  123.              group_210                           pick           what_next         
  124.              group_-3                            pick_list                
  125.                                                  poly_val       which_box         
  126.                                                  pos            which_list        
  127.                                                  pr             ws                
  128.                                hmmm              redefine       x_op              
  129.                                huh               remove         x_value           
  130.                                i                 remove_flag    y_op              
  131.                                init_lists        ri_ops         y_value           
  132.                                                 rm_item        z_op              
  133.                                item              rs_err         z_value           
  134.                                item1             s             
  135.                                item2             save_all      
  136.              dp1               item_index        save_as       
  137.              dp2               j                 select        ret_list
  138.              )
  139.   ;;
  140.   ;; Action on Add Selected Entity button.
  141.   ;;
  142.   (defun do_select_entity ()
  143.     (setq edit_item (atoi (get_tile "filter_str_list")))
  144.     (done_dialog 2)
  145.   )
  146.   ;;
  147.   ;; Action on Remove button.
  148.   ;;
  149.   (defun do_remove ()
  150.     (setq remove_flag 1)
  151.     (remove)
  152.     (setq remove_flag 0)
  153.   )
  154.   ;;
  155.   ;; Initialise the English list and corresponding group code list.  The list
  156.   ;; of operators is also initialised.
  157.   ;;
  158.   ;; This is the only thing that has to be translated to each language.
  159.   ;; the rest of the program MUST, remain in english, and don't worry
  160.   ;; the messages to screen will appear in language.
  161.   ;;
  162.   (defun init_lists()
  163.     (setq filter_list (list 
  164.                         "Arco"          "Centro arco"         "Radio arco"
  165.                         "Atributo"    "Posici≤n atributo" "Identif. atributos" 
  166.                         "Cuerpo"
  167.                         "Bloque"        "Nombre bloque"         "Posici≤n bloque"
  168.                                        "Rotaci≤n bloque"
  169.                         "Cφrculo"       "Centro cφrculo"      "Radio cφrculo" 
  170.                         "Color"         
  171.                         "Acotaci≤n"    "Estilo acotaci≤n" 
  172.                         "Elevaci≤n"     
  173.                         "Elipse"      "Centro elipse"
  174.                         "Capa"
  175.                         "Directriz"
  176.                         "Lφnea"         "Inicio de lφnea"         "Fin de lφnea"
  177.                         "Tipo de lφnea"
  178.                         "Escala tipo lφnea"
  179.                         "Lφnea m·ltiple"    "Estilo LM·ltiple"
  180.                         "Vector normal"
  181.                         "Punto"        "Posici≤n punto"
  182.                         "Polilφnea"      
  183.                         "Rayo"
  184.                         "Regi≤n"
  185.                         "Forma"        "Posici≤n forma"     "Nombre forma"                                            
  186.                         "S≤lido"
  187.                         "Cuerpo s≤lido"
  188.                         "Spline"
  189.                         "Texto"         "Posici≤n texto"      "Valor del texto"
  190.                                        "Nombre estilo texto"    "Altura texto" 
  191.                                        "Rotaci≤n texto"
  192.                         "Trazo"
  193.                         "3dcara"
  194.                         "Altura de objeto"
  195.                         "Tolerancia"
  196.                         "Ventana grßfica"     "Centro de ventana" 
  197.                         "ID de Xdata"
  198.                         "LφneaX"
  199.                         "** Inicio  AND"
  200.                         "** Fin    AND"
  201.                         "** Inicio  OR"
  202.                         "** Fin     OR"
  203.                         "** Inicio XOR"
  204.                         "** Fin    XOR"
  205.                         "** Inicio NOT"
  206.                         "** Fin    NOT"
  207.                   )
  208.     )
  209.  
  210.     (setq filter_gc (list 
  211.                          0 10 40  
  212.                          0 10  2  
  213.                          0
  214.                          0  2 10 50 
  215.                          0 10 40
  216.                          62
  217.                          0  3 
  218.                          38 
  219.                          0 10
  220.                          8
  221.                          0
  222.                          0 10 11
  223.                          6
  224.                          48
  225.                          0 2
  226.                          210
  227.                          0 10
  228.                          0 
  229.                          0
  230.                          0
  231.                          0 10  2
  232.                          0
  233.                          0
  234.                          0
  235.                          0 10  1  7 40 50
  236.                          0
  237.                          0
  238.                          39
  239.                          0
  240.                          0 10 
  241.                          -3
  242.                          0
  243.                          "<AND" "AND>"
  244.                          "<OR"  "OR>"
  245.                          "<XOR" "XOR>"
  246.                          "<NOT" "NOT>"
  247.         )
  248.     )
  249.     (setq ri_ops (list "=" "!=" "<" "<=" ">" ">=" "*"))  
  250.   )
  251.   ;;
  252.   ;; Function to reset the error tile.
  253.   ;;
  254.   (defun rs_err()
  255.     (set_tile "error" "")
  256.   )
  257.   ;;
  258.   ;; Function called by SELECT button.  Used to bring the Color dialogue and
  259.   ;; the symbol table dialogues.  Groups and Mline Styles not supported yet...
  260.   ;;
  261.   (defun select (/ current_filter selection_list color_no poly_val str 
  262.                    table_name lay_clr
  263.                 )
  264.     (setq current_filter (nth (atoi (get_tile "filter_by")) filter_list_english))
  265.     (cond 
  266.       ((= "Color" current_filter)   ; if Color 
  267.         ;; Get current layer's color, for use in BYLAYER color swatch.
  268.         (setq lay_clr (cdr (assoc 62 (tblsearch "layer" (getvar "clayer")))))
  269.         (if (setq color_no (acad_colordlg 1 T lay_clr)) ; and a color is selected
  270.           (set_tile "x_value" (itoa color_no))     
  271.         )
  272.       )
  273.       (t (cond 
  274.            ((= "Block Name"      current_filter) (setq table_name "Block"))
  275.            ((= "Dimension Style" current_filter) (setq table_name "Dimstyle")) 
  276.            ((= "Layer"           current_filter) (setq table_name "Layer"))
  277.            ((= "Linetype"        current_filter) (setq table_name "Ltype"))
  278.            ((= "Text Style Name" current_filter) (setq table_name "Style"))
  279.            ((= "Xdata ID"  current_filter) (setq table_name "Appid"))
  280.            (t (princ "Error de programaci≤n al seleccionar"))
  281.          )
  282.          (setq pregun (en_to_loc current_filter)) ;Added for loc.
  283.          (if (setq selection_list (reverse (single_table table_name 
  284.                    (strcat " " pregun " " ))))
  285.            (progn 
  286.              (setq n   0
  287.                    str "")
  288.              (while (< n (length selection_list))
  289.                (setq str (strcat (nth n selection_list) "," str))
  290.                (setq n (1+ n))
  291.              )
  292.              (set_tile "x_value" (substr str 1 (1- (strlen str))))
  293.            )
  294.         )
  295.       )
  296.     )
  297.   )
  298.   ;;
  299.   ;;  Deletes the current named list from the list of named lists.
  300.   ;;
  301.   (defun delete_list()
  302.     (if (/= 0 (setq pick_list (atoi (get_tile "named_lists"))))
  303.       (progn 
  304.         (setq all_lisp_list (rm_item pick_list all_lisp_list))
  305.         (save_all)
  306.         (start_list "named_lists")
  307.         (mapcar 'add_list all_lisp_list)
  308.         (end_list)
  309.         (set_tile "named_lists" "0")
  310.         (setq filter_str_list ai_str|*unnamed)
  311.         (setq filter_lisp_list ai_lisp|*unnamed)
  312.         (start_list "filter_str_list")
  313.         (mapcar 'add_list filter_str_list)
  314.         (end_list)
  315.       )
  316.       (set_tile "error" "Imposible borrar la lista de filtros *s-nombre.")
  317.     )
  318.   )
  319.   ;;
  320.   ;; Retrieves the named lists from file. (NFL = Named Filter Lists)
  321.   ;;
  322.   (defun load_log(/ filter_nfl nfl_lisp nfl_str current_line)
  323.     ;; Look for .nfl file in the standard places. 
  324.     (if (not (setq filename (findfile "filter.nfl")))
  325.       (setq filename "filter.nfl")
  326.     )
  327.     (if (setq filter_nfl (open filename "r"))
  328.       (progn 
  329.         (setq current_line (read-line filter_nfl))
  330.         (while (and (/= "" current_line)
  331.                     (/= nil current_line)
  332.                     (/= ":" (substr current_line 1 1))) ; skip comments
  333.          (setq current_line (read-line filter_nfl))
  334.         )
  335.         (while current_line                       ; get lisp
  336.           (setq name (substr current_line 10))     ; get list name
  337.           (setq all_lisp_list (cons name all_lisp_list))
  338.           (setq current_line (read-line filter_nfl))
  339.           (while (/= ":" (substr current_line 1 1))
  340.             (setq nfl_lisp (cons (read current_line) nfl_lisp))
  341.             (setq current_line (read-line filter_nfl))
  342.           )
  343.           (set (read (strcat "ai_lisp|" name)) (reverse nfl_lisp))
  344.           (setq nfl_lisp '())
  345.           (setq current_line (read-line filter_nfl))         ; get str
  346.           (set (read (strcat "ai_str|" name)) '())
  347.           (while (and current_line (/= ":" (substr current_line 1 1)))
  348.             (setq nfl_str (cons current_line nfl_str))
  349.             (setq current_line (read-line filter_nfl))
  350.           )
  351.           (set (read (strcat "ai_str|" name)) (reverse (cons "" nfl_str)))
  352.           (setq nfl_str '())
  353.         )
  354.         (if (and all_lisp_list 
  355.                  (< (length all_lisp_list) (getvar "maxsort"))
  356.             )
  357.           (setq all_lisp_list (acad_strlsort all_lisp_list))
  358.         )
  359.         (start_list "named_lists")
  360.         (mapcar 'add_list all_lisp_list)
  361.         (end_list)
  362.         (set_tile "named_lists" "0")
  363.         (close filter_nfl)
  364.       )
  365.     )
  366.   )
  367.   ;;
  368.   ;;  Saves named lists to file.
  369.   ;;
  370.   (defun save_all(/ filter_nfl)
  371.     ;; Look for .nfl file in the standard places. 
  372.     (if (not (setq filename (findfile "filter.nfl")))
  373.       (setq filename "filter.nfl")
  374.     )
  375.     (if (setq filter_nfl (open filename "w"))
  376.       (progn
  377.         (write-line "Filter.nfl  --  No edite este archivo." filter_nfl)
  378.         (if (< 1 (length all_lisp_list))
  379.           (progn
  380.             (foreach n all_lisp_list
  381.               (if (/= n "*s-nombre")
  382.                 (progn
  383.                   (write-line (strcat ":ai_lisp|" n) filter_nfl)
  384.                   (foreach n1 
  385.                     (reverse (lts (eval (read (strcat "ai_lisp|" n))) 1))
  386.                     (write-line n1 filter_nfl)
  387.                   )
  388.                   (write-line (strcat ":ai_str|" n) filter_nfl)
  389.                   (foreach n1 (eval (read (strcat "ai_str|" n)))
  390.                     (if (/= "" n1) (write-line n1 filter_nfl))
  391.                   )
  392.                 )
  393.               )
  394.             )
  395.           )
  396.         )
  397.         (close filter_nfl)
  398.       )
  399.       (alert (strcat "Imposible guardar lista de filtros en un archivo \n"
  400.                      " - el directorio debe tener permiso de escritura."
  401.              )
  402.       )
  403.     )
  404.   )
  405.   ;;
  406.   ;; If not the *unnamed list, make current the selected one.
  407.   ;;
  408.   (defun named_lists()
  409. ;    (cond
  410. ;      ((/= "0" (get_tile "named_lists"))
  411.         (setq list_name (nth (atoi (get_tile "named_lists")) all_lisp_list))
  412.         ;; Localization fix 
  413.         (if (= list_name "*s-nombre") 
  414.              (setq list_name "*unnamed")
  415.         )
  416.         (setq filter_lisp_list 
  417.               (eval (read 
  418.                       (strcat "ai_lisp|" list_name)
  419.               ))
  420.         )
  421.         (setq filter_str_list 
  422.               (eval (read 
  423.                       (strcat "ai_str|" list_name)
  424.               ))
  425.         )
  426.         (start_list "filter_str_list")
  427.         (mapcar 'add_list filter_str_list)
  428.         (end_list)
  429. ;      )
  430. ;    )
  431.   )
  432.  
  433.   ;;
  434.   ;; Check the entered name and if valid, save it.
  435.   ;;
  436.   (defun save_as()
  437.     (setq list_name (ai_strtrim (get_tile "new_name")))
  438.     (cond
  439.       ((or (= nil list_name)(= "" list_name))
  440.         (set_tile "error" "No se permite nombre de filtro vacφo.")
  441.       )
  442.       ((wcmatch list_name "*[]`#`@`.`?`*`~`[`,`'!%^&()+={}|`\\:;\"<>/]*")
  443.         (set_tile "error" "Caracteres no vßlidos en el nombre de filtro.")
  444.       )
  445.       ((= "*s-nombre" list_name) 
  446.         (set_tile "error" "Nombre de filtro no vßlido.")
  447.       )
  448.       ((and (member list_name all_lisp_list) (not (redefine))))
  449.       ((lisp_error)) 
  450.       (T 
  451.         (set (read (eval (strcat "ai_lisp|" list_name))) filter_lisp_list)
  452.         (set (read (eval (strcat "ai_str|" list_name))) filter_str_list)
  453.         (if (not (member list_name all_lisp_list)) ; add if not member
  454.           (progn
  455.             (setq all_lisp_list (cons list_name all_lisp_list))
  456.             (if (and all_lisp_list
  457.                      (< (length all_lisp_list) (getvar "maxsort"))
  458.                 )
  459.               (setq all_lisp_list (acad_strlsort all_lisp_list))
  460.             )
  461.           )
  462.         )
  463.         (start_list "named_lists")
  464.         (mapcar 'add_list all_lisp_list)
  465.         (end_list)
  466.         (set_tile "named_lists" (itoa (what_pos list_name all_lisp_list)))
  467.         (save_all)
  468.       ) 
  469.     )
  470.   )
  471.   ;;
  472.   ;; If the entered name for the filter list matches an existing name, call
  473.   ;; dialogue for confirmation to redefine it.  T is returned if OK to redefine.
  474.   ;;
  475.   (defun redefine ()
  476.     (if (not (new_dialog "already_exists" dcl_id)) (exit))   
  477.     (action_tile "redefine" "(done_dialog 2)")
  478.     (action_tile "cancel" "(done_dialog 0)")
  479.     (if (= (start_dialog) 2) t)           ; return t on Redefine, nil on cancel
  480.   )
  481.   ;;
  482.   ;; Debugging routine.
  483.   ;;
  484.   (defun pr()
  485.     (princ filter_str_list)
  486.     (princ filter_lisp_list)
  487.   )
  488.   ;;
  489.   ;;  Routine that updates the current English and Lisp lists to contain the
  490.   ;;  new English and Lisp arguments.
  491.   ;;
  492.   (defun update (new_str new_lisp / str1 str2 i edit_this lisp_pos temp_str)
  493.     ; find current position in filter_lisp_list (list of lists)
  494.     (setq i -1)
  495.     (setq edit_this -1)        ; corresponding item in lisp list.
  496.     (setq lisp_pos -1)         ; so that length below occurs
  497.     (if filter_lisp_list
  498.       (progn
  499.         (while (< edit_this str_pos)  ; until they are equal
  500.           (setq i (1+ i))
  501.           (if (not (and (= -4 (car (nth i filter_lisp_list)))   
  502.                        (not (member 
  503.                               (cdr (nth i filter_lisp_list)) 
  504.                               '("<AND" "AND>" "<OR"  "OR>" 
  505.                                "<XOR" "XOR>" "<NOT" "NOT>")
  506.                             )
  507.                        )
  508.                    )
  509.               )
  510.             (progn 
  511.               (setq edit_this (1+ edit_this))        
  512.             )
  513.           )
  514.         )
  515.         (if (and (< 0 i) 
  516.                  (and (= -4 (car (nth (1- i) filter_lisp_list)))   
  517.                       (not (member 
  518.                              (cdr (nth (1- i) filter_lisp_list)) 
  519.                              '("<AND" "AND>" "<OR"  "OR>" 
  520.                                "<XOR" "XOR>" "<NOT" "NOT>")
  521.                            )
  522.                       )
  523.                  )
  524.             )
  525.           (setq lisp_pos (1- i))
  526.           (setq lisp_pos i)
  527.         )
  528.       )
  529.     )
  530.     ; join lisp lists
  531.     (setq i 0)
  532.     (setq str1 '()) (setq str2 '())
  533.     (if (<= 0 lisp_pos)
  534.       (progn 
  535.         (while (< i lisp_pos)
  536.           (setq str1 (cons (nth i filter_lisp_list) str1))   
  537.           (setq i (1+ i))
  538.         )
  539.         (setq str1 (reverse str1))
  540.         (setq temp_str (reverse filter_lisp_list))
  541.         (setq i 0)
  542.         (while (<= i (- (- (length filter_lisp_list) lisp_pos) 1))
  543.           (setq str2 (cons (nth i temp_str) str2))   
  544.           (setq i (1+ i))
  545.         )
  546.       )
  547.     )
  548.     (setq filter_lisp_list (append str1 new_lisp str2))
  549.     (setq ai_lisp|*unnamed filter_lisp_list)
  550.     ; join string lists
  551.     (setq i 0)
  552.     (setq str1 '()) (setq str2 '())
  553.     (while (< i str_pos)
  554.       (setq str1 (cons (nth i filter_str_list) str1))   
  555.       (setq i (1+ i))
  556.     )
  557.     (setq str1 (reverse str1))
  558.     (setq temp_str (reverse filter_str_list))
  559.     (setq i 0)
  560.     (while (<= i (- (- (length filter_str_list) str_pos) 1))
  561.       (setq str2 (cons (nth i temp_str) str2))   
  562.       (setq i (1+ i))
  563.     )
  564.     (setq filter_str_list (append str1 new_str str2))
  565.     (setq ai_str|*unnamed filter_str_list)
  566.     ; Update displayed string list
  567.     (start_list "filter_str_list")
  568.     (mapcar 'add_list filter_str_list)
  569.     (end_list)
  570.  
  571.     (setq new_length (length new_str))   ; length of new string list.
  572.     (cond
  573.      ((/= (1- (length filter_str_list)) str_pos)
  574.        (set_tile "filter_str_list" 
  575.                  (itoa (setq str_pos (+ str_pos new_length)))
  576.        )
  577.      )
  578.      ((and (= (1- (length filter_str_list)) str_pos)
  579.            (/= 1 (length filter_str_list))
  580.       )
  581.        (set_tile "filter_str_list" (itoa (1- str_pos)))
  582.      )
  583.      (T)
  584.     )
  585.   )
  586.   ;;
  587.   ;; Disables the controls when an filter is chosen from the list of possible 
  588.   ;; filters
  589.   ;;
  590.   (defun grey_filter ( )
  591.     (setq pick (nth (atoi (get_tile "filter_by")) filter_list_english)) ;Added for loc.
  592.     (enable_disable pick)
  593.   )
  594.   ;;
  595.   ;; Disables the controls according to current selection.
  596.   ;;
  597.   (defun enable_disable(string)
  598.     ;; Localization fix
  599.     (setq tstr string)
  600.     (if (not (setq string (loc_to_en tstr))) (setq string tstr))
  601.     ;; Debug
  602.     ;; (princ "DEBUG> string is: ") (princ string) (princ "\n")
  603.     
  604.     (cond 
  605.       ((member string '(
  606.                       "Arc" "Attribute" "Block" "Circle" "Dimension" "Ellipse"
  607.                       "Line" "MultiLine" "Point" "Polyline" "Ray" "Region"
  608.                       "Shape"  "Solid" "3D Solid" "Spline" "Trace" "3dface"
  609.                       "Viewport" "Xline"  "Text" "Leader" "Tolerance" "Body"
  610.                        "** Begin  AND" "** End    AND"
  611.                        "** Begin  OR"  "** End    OR"
  612.                        "** Begin  XOR" "** End    XOR"
  613.                        "** Begin  NOT" "** End    NOT"                      
  614.        ))
  615.        (mode_tile "x_op" 1) (mode_tile "x_value" 1) (mode_tile "x_text" 1)
  616.        (mode_tile "y_op" 1) (mode_tile "y_value" 1) (mode_tile "y_text" 1)
  617.        (mode_tile "z_op" 1) (mode_tile "z_value" 1) (mode_tile "z_text" 1)
  618.        (mode_tile "select" 1)
  619.       )
  620.       ((member string '(
  621.                        "Arc Center"
  622.                        "Attribute Position"
  623.                        "Block Position"
  624.                        "Circle Center"
  625.                        "Ellipse Center"
  626.                        "Line Start"          "Line End"
  627.                        "Point Position" 
  628.                        "Shape Position"
  629.                        "Solid Point 1"       "Solid Point 2"   "Solid Point 3"
  630.                        "Solid Point 4"
  631.                        "Text Position"
  632.                        "Trace Point 1"       "Trace Point 2"   "Trace Point 3"
  633.                        "Trace Point 4"
  634.                        "3dface Point 1"      "3dface Point 2"  "3dface Point 3"
  635.                        "3dface Point 4"
  636.                        "Viewport Center"
  637.                        )
  638.        )
  639.         (mode_tile "x_op" 0) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  640.         (mode_tile "y_op" 0) (mode_tile "y_value" 0) (mode_tile "y_text" 0)
  641.         (mode_tile "z_op" 0) (mode_tile "z_value" 0) (mode_tile "z_text" 0)
  642.         (mode_tile "select" 1)
  643.       )
  644.       ((member string '(
  645.                        "Elevation" "Thickness"
  646.                        "Arc Radius"
  647.                        "Block X Scale"   "Block Y Scale" "Block Z Scale"
  648.                        "Block Rotation"
  649.                        "Circle Radius"
  650.                        "Linetype Scale"
  651.                        "Text Height"     "Text Rotation"
  652.                        )
  653.        )
  654.         (mode_tile "x_op" 0) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  655.         (mode_tile "y_op" 1) (mode_tile "y_value" 1) (mode_tile "y_text" 1)
  656.         (mode_tile "z_op" 1) (mode_tile "z_value" 1) (mode_tile "z_text" 1)
  657.         (mode_tile "select" 1)
  658.       )
  659.       ((member string '(
  660.                        "Color"                    
  661.                        )
  662.        )
  663.         (mode_tile "x_op" 0) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  664.         (mode_tile "y_op" 1) (mode_tile "y_value" 1) (mode_tile "y_text" 1)
  665.         (mode_tile "z_op" 1) (mode_tile "z_value" 1) (mode_tile "z_text" 1)
  666.         (mode_tile "select" 0)
  667.       )
  668.       ((member string '(
  669.                        "Dimension Type" 
  670.                        "Polyline Flags" "Viewport Status"                   
  671.                        )
  672.        )
  673.         (mode_tile "x_op" 0) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  674.         (mode_tile "y_op" 1) (mode_tile "y_value" 1) (mode_tile "y_text" 1)
  675.         (mode_tile "z_op" 1) (mode_tile "z_value" 1) (mode_tile "z_text" 1)
  676.         (mode_tile "select" 1)
  677.       )
  678.       ((member string '(
  679.                        "Attribute Tag"  
  680.                        "Text Value"  
  681.                        "Shape Name"
  682.                        "MultiLine Style"
  683.                        )
  684.        )
  685.         (mode_tile "x_op" 1) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  686.         (mode_tile "y_op" 1) (mode_tile "y_value" 1) (mode_tile "y_text" 1)
  687.         (mode_tile "z_op" 1) (mode_tile "z_value" 1) (mode_tile "z_text" 1)
  688.         (mode_tile "select" 1)
  689.       )
  690.       ((member string '(
  691.                        "Block Name" 
  692.                        "Dimension Style" 
  693.                        "Layer" 
  694.                        "Linetype" 
  695.                        "Text Style Name" 
  696.                        "Xdata ID"
  697.                        )
  698.        )       
  699.         (mode_tile "x_op" 1) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  700.         (mode_tile "y_op" 1) (mode_tile "y_value" 1) (mode_tile "y_text" 1)
  701.         (mode_tile "z_op" 1) (mode_tile "z_value" 1) (mode_tile "z_text" 1)
  702.         (mode_tile "select" 0)
  703.       )
  704.       ((member string '(
  705.                        "Normal Vector"
  706.                        )
  707.        )       
  708.         (mode_tile "x_op" 0) (mode_tile "x_value" 0) (mode_tile "x_text" 0)
  709.         (mode_tile "y_op" 1) (mode_tile "y_value" 0) (mode_tile "y_text" 0)
  710.         (mode_tile "z_op" 1) (mode_tile "z_value" 0) (mode_tile "z_text" 0)
  711.         (mode_tile "select" 1)
  712.       )
  713.     )
  714.   )
  715.   ;;
  716.   ;; Add the selected filter, operator, and value to list.
  717.   ;;
  718.   (defun add_to_list (/ gc_name op val str_val)
  719.     (setq str_pos (atoi (get_tile "filter_str_list")))  ; item in string list.
  720.     (setq op nil)(setq val nil)(setq str_val nil)
  721.     (setq gc_name (nth (atoi (get_tile "filter_by")) filter_list))
  722.  
  723.     ;Begining of translation part.
  724.     (setq LOCGC gc_name)
  725.     (setq gc_name (loc_to_en LOCGC))
  726.     ; This is for DEBUGING (princ "JMC En ingles es::::> ")(princ gc_name)
  727.     ; End of new part.
  728.  
  729.     (cond
  730.       ((member gc_name '(
  731.                         "Arc Center"
  732.                         "Attribute Position"
  733.                         "Block Position"
  734.                         "Circle Center"
  735.                         "Ellipse Center"
  736.                         "Line Start"         "Line End"
  737.                         "Point Position" 
  738.                         "Shape Position"
  739.                         "Text Position"
  740.                         "Viewport Center"
  741.                         )
  742.        )     
  743.         (setq op (cons -4 (strcat 
  744.                             (setq x_op (nth (atoi (get_tile "x_op")) ri_ops)) 
  745.                             ","
  746.                             (setq y_op (nth (atoi (get_tile "y_op")) ri_ops)) 
  747.                             ","
  748.                             (setq z_op (nth (atoi (get_tile "z_op")) ri_ops))
  749.                            )
  750.                   )
  751.         )
  752.         (cond
  753.           ((not (setq x_value 
  754.                       (ai_num (get_tile "x_value") "Coordenada X no vßlida." 0)
  755.                 )
  756.            )
  757.            (mode_tile "x_value" 2)
  758.           )
  759.           ((not (setq y_value 
  760.                       (ai_num (get_tile "y_value") "Coordenada Y no vßlida." 0)
  761.                 )
  762.            )
  763.            (mode_tile "y_value" 2)
  764.           )
  765.           ((not (setq z_value 
  766.                       (ai_num (get_tile "z_value") "Coordenada Z no vßlida." 0)
  767.                 )
  768.            )
  769.            (mode_tile "z_value" 2)
  770.           )
  771.           (T (setq val 
  772.                    (list 
  773.                          (nth (what_pos gc_name filter_list_english) filter_gc) ;Added for loc. 
  774.                          x_value 
  775.                          y_value 
  776.                          z_value
  777.                    )
  778.              )
  779.              (setq GCLOC (en_to_loc gc_name)) ;Added for loc.
  780.          (setq str_val (strcat GCLOC "\tX\t" x_op "\t" (ai_rtos x_value)
  781.                                            "\tY\t" y_op "\t" (ai_rtos y_value)
  782.                                            "\tZ\t" z_op "\t" (ai_rtos z_value)
  783.                            )
  784.              )
  785.           )
  786.         )
  787.       )
  788.       ((member gc_name '("Normal Vector"))
  789.         (setq op (cons -4 (setq x_op (nth (atoi (get_tile "x_op")) ri_ops))))
  790.         (cond
  791.           ((not (setq x_value 
  792.                       (ai_num (get_tile "x_value") "Coordenada X no vßlida." 0)
  793.                 )
  794.            )
  795.            (mode_tile "x_value" 2)
  796.           )
  797.           ((not (setq y_value 
  798.                       (ai_num (get_tile "y_value") "Coordenada Y no vßlida." 0)
  799.                 )
  800.            )
  801.            (mode_tile "y_value" 2)
  802.           )
  803.           ((not (setq z_value 
  804.                       (ai_num (get_tile "z_value") "Coordenada Z no vßlida." 0)
  805.                 )
  806.            )
  807.            (mode_tile "z_value" 2)
  808.           )
  809.           (T (setq val (list 
  810.                              (nth (what_pos gc_name filter_list_english) filter_gc) 
  811.                              x_value 
  812.                              y_value 
  813.                              z_value
  814.                        )
  815.              )
  816.          (setq GCLOC (en_to_loc gc_name)) ; Added for loc.
  817.              (setq str_val (strcat GCLOC     "\tX\t" x_op "\t" (ai_rtos x_value) 
  818.                                                "\tY\t" x_op "\t" (ai_rtos y_value)
  819.                                                "\tZ\t" x_op "\t" (ai_rtos z_value)
  820.                            )
  821.              )
  822.           )
  823.         )
  824.       )
  825.       ((member gc_name '(
  826.                           "Elevation" "Thickness"
  827.                           "Arc Radius"
  828.                           "Block X Scale"   "Block Y Scale" "Block Z Scale"
  829.                           "Circle Radius"
  830.                           "Linetype Scale"
  831.                           "Text Height"    
  832.                         )
  833.        )     
  834.         (setq op (cons -4 (setq x_op (nth (atoi (get_tile "x_op")) ri_ops))))
  835.         (cond
  836.           ((not (setq x_value 
  837.                       (ai_num (get_tile "x_value") "N·mero no vßlido." 0)
  838.                 )
  839.            )
  840.            (mode_tile "x_value" 2)
  841.           )
  842.           (T (setq val 
  843.                    (cons (nth (what_pos gc_name filter_list_english) filter_gc) 
  844.                          x_value
  845.                    )
  846.              )
  847.              (setq GCLOC (en_to_loc gc_name)) ;Added for loc.
  848.              (setq str_val (strcat GCLOC  "\t\t" x_op "\t" (ai_rtos x_value)))
  849.           )
  850.         )
  851.       )
  852.       ((member gc_name '(
  853.                           "Block Rotation"
  854.                           "Text Rotation"
  855.                         )
  856.        )     
  857.         (setq op (cons -4 (setq x_op (nth (atoi (get_tile "x_op")) ri_ops))))
  858.         (cond
  859.           ((not (setq x_value 
  860.                       (ai_angle (get_tile "x_value") "Angulo no vßlido.")
  861.                 )
  862.            )
  863.            (mode_tile "x_value" 2)
  864.           )
  865.           (T (setq val 
  866.                    (cons (nth (what_pos gc_name filter_list_english) filter_gc) 
  867.                          (angtof (get_tile "x_value") (getvar "aunits"))
  868.                    )
  869.              )
  870.          (setq GCLOC (en_to_loc gc_name)) ; Added for loc.
  871.               (setq str_val (strcat GCLOC  "\t\t" x_op "\t" (get_tile "x_value") ))
  872.           )
  873.         )
  874.       )
  875.       ((member gc_name '(
  876.                          "Color" 
  877.                         )
  878.        )
  879.         (setq op (cons -4 (setq x_op (nth (atoi (get_tile "x_op")) ri_ops))))
  880.         (cond
  881.           ((not (setq x_value 
  882.                       (check_color (get_tile "x_value"))
  883.                 )
  884.            )
  885.            (mode_tile "x_value" 2)
  886.           )
  887.           (T (setq val 
  888.                    (cons (nth (what_pos gc_name filter_list_english) filter_gc) 
  889.                          x_value
  890.                    )
  891.              )
  892.              (cond 
  893.                ((= 0 x_value)   (setq x_value "0 - Por Bloque"))
  894.                ((= 1 x_value)   (setq x_value "1 - Rojo"))
  895.                ((= 2 x_value)   (setq x_value "2 - Amarillo"))
  896.                ((= 3 x_value)   (setq x_value "3 - Verde"))
  897.                ((= 4 x_value)   (setq x_value "4 - Ciano"))
  898.                ((= 5 x_value)   (setq x_value "5 - Azul"))
  899.                ((= 6 x_value)   (setq x_value "6 - Magenta"))
  900.                ((= 7 x_value)   (setq x_value "7 - Blanco"))
  901.                ((= 256 x_value) (setq x_value "256 - Por Capa"))
  902.                (t (setq x_value (itoa x_value)))
  903.              )
  904.              (setq GCLOC (en_to_loc gc_name)) ; Added for loc.
  905.              (setq str_val (strcat GCLOC "\t\t" x_op "\t" x_value))
  906.           )
  907.         )
  908.       )
  909.       ((member gc_name '(
  910.                           "Attribute Tag" "Block Name" 
  911.                           "Dimension Style" 
  912.                           "Layer" "Linetype" 
  913.                           "Shape Name"
  914.                           "Text Value" "Text Style Name" 
  915.                           "MultiLine Style"
  916.                         )
  917.        )         
  918.         (cond
  919.           ((= "" (setq x_value (ai_strtrim (get_tile "x_value"))))
  920.             (mode_tile "x_value" 2)
  921.           )
  922.           (T (setq val 
  923.                    (cons (nth (what_pos gc_name filter_list_english) filter_gc) 
  924.                          x_value
  925.                    )
  926.              )
  927.          (setq GCLOC (en_to_loc gc_name))
  928.              (setq str_val (strcat GCLOC "\t\t=\t" x_value))
  929.           )
  930.         )
  931.       )
  932.       ((member gc_name '("Xdata ID"))
  933.         (cond
  934.           ((= "" (setq x_value (ai_strtrim (get_tile "x_value"))))
  935.             (mode_tile "x_value" 2)
  936.           )
  937.           (T (setq val 
  938.                      (cons 
  939.                        (nth (what_pos gc_name filter_list_english) filter_gc) 
  940.                        (list (list x_value))
  941.                      )
  942.              )
  943.          (setq GCLOC (en_to_loc gc_name))
  944.              (setq str_val (strcat GCLOC "\t\t=\t" x_value))
  945.           )
  946.         )
  947.       )
  948.       ((member gc_name '(
  949.                         "Arc" "Circle" "Dimension" "Line" "Point" "Polyline"
  950.                         "Shape" "Solid" "Trace" "3dface" "Viewport" "Ellipse"
  951.                         "Ray" "Region" "Xline" "Spline" "Tolerance" "Leader"
  952.                         "Body"
  953.                         )
  954.        )
  955.         (setq val (cons 0 gc_name))
  956.         (setq str_val (strcat "Objeto         \t\t=\t" LOCGC)) 
  957.       )
  958.       ((member gc_name '(
  959.                          "Attribute"  
  960.                         )
  961.        )
  962.         (setq val (cons 0 "ATTDEF"))
  963.         (setq str_val (strcat "Objeto         \t\t=\t" LOCGC)) 
  964.       )
  965.       ((member gc_name '(
  966.                          "Block" 
  967.                         )
  968.        )
  969.         (setq val (cons 0 "INSERT"))
  970.         (setq str_val (strcat "Objeto         \t\t=\t" LOCGC)) 
  971.       )
  972.       ((member gc_name '(
  973.                          "MultiLine"
  974.                         )
  975.        )
  976.         (setq val (cons 0 "MLINE"))
  977.         (setq str_val (strcat "Objeto         \t\t=\t" LOCGC))
  978.       )
  979.       ((member gc_name '(
  980.                          "3D Solid"
  981.                         )
  982.        )
  983.         (setq val (cons 0 "3DSOLID"))
  984.         (setq str_val (strcat "Objeto         \t\t=\t" LOCGC))
  985.       )
  986.       ;; Text and MText
  987.       ((member gc_name '(
  988.                          "Text"
  989.                         )
  990.        )
  991.         (setq val (cons 0 "*TEXT"))
  992.         (setq str_val (strcat "Objeto         \t\t=\t" LOCGC))
  993.       )
  994.       ((member gc_name '(
  995.                         "** Begin  AND"  "** End    AND"
  996.                         "** Begin  OR"   "** End    OR"
  997.                         "** Begin  XOR"  "** End    XOR"
  998.                         "** Begin  NOT"  "** End    NOT"
  999.                         )
  1000.        )
  1001.         (setq val (cons -4  (nth (what_pos gc_name filter_list_english) filter_gc)))
  1002.     (setq GCLOC (en_to_loc gc_name))
  1003.         (setq str_val (strcat GCLOC "\t")) 
  1004.       )
  1005.       (T)
  1006.     )
  1007.     (cond 
  1008.       ((and op val str_val)
  1009.         (update (list str_val) (list op val))
  1010.         (set_tile "named_lists" "0")
  1011.       )
  1012.       ((and val str_val)
  1013.         (update (list str_val) (list val))
  1014.         (set_tile "named_lists" "0")
  1015.       )
  1016.       (T)
  1017.     )
  1018.   )
  1019.   ;;
  1020.   ;; Check if value passed is a valid color integer.  If valid, return the 
  1021.   ;; integer, else nil.
  1022.   ;;
  1023.   (defun check_color(value)
  1024.     (if (or (wcmatch value "*@*,*.*")  ;  alphabetic or nonalphanumeric.
  1025.              (>  0 (distof value))
  1026.              (<  256 (distof value))
  1027.         )
  1028.       (progn (set_tile "error" "N·mero de color no vßlido.") nil)
  1029.       (atoi value) 
  1030.     )
  1031.   )
  1032.   ;;
  1033.   ;; Check if value passed is an integer.  If valid, return the integer, else
  1034.   ;; nil.
  1035.   ;;
  1036.   (defun check_int(value)
  1037.     (if (and (wcmatch value "*@*,*.*")  ;  
  1038.              (<= 0 value)
  1039.              (<  256 value))
  1040.       (progn (set_tile "error" "N·mero de color no vßlido.") nil)
  1041.       (atoi value) 
  1042.     )
  1043.   )
  1044.   ;;
  1045.   ;; Pass an item and a list and recieve a number showing it's position in  
  1046.   ;; the list, nil otherwise.  Item must be in the list, and the list must 
  1047.   ;; contain unique names. 0 if first item.                               
  1048.   ;;
  1049.   (defun what_pos (item the_list / pos)
  1050.     (setq pos (- (length the_list)
  1051.                  (length (member item the_list)))
  1052.     )          
  1053.   )
  1054.   ;;
  1055.   ;; Remove item from English and Lisp lists.
  1056.   ;;
  1057.   (defun remove()
  1058.     (setq str_pos (atoi (get_tile "filter_str_list")))  ; item in string list.
  1059.     (if (/= (1- (length filter_str_list)) str_pos) ; don't remove the blank 
  1060.       (progn
  1061.         ; strip 1 item from string list
  1062.         (setq filter_str_list (rm_item str_pos filter_str_list))
  1063.         (setq ai_str|*unnamed filter_str_list)
  1064.         (setq i -1)
  1065.         (setq edit_this -1)        ; corresponding item in lisp list.
  1066.         (while (< edit_this str_pos)  ; until they are equal
  1067.           (setq i (1+ i))
  1068.           (if (not (and (= -4 (car (nth i filter_lisp_list)))  
  1069.                         (not (member (cdr (nth i filter_lisp_list)) 
  1070.                                   '("<AND" "AND>" "<OR"  "OR>" 
  1071.                                     "<XOR" "XOR>" "<NOT" "NOT>")
  1072.                              )
  1073.                         )
  1074.                    )
  1075.               )
  1076.             (setq edit_this (1+ edit_this))        
  1077.           )
  1078.         )
  1079.         (setq filter_lisp_list (rm_item i filter_lisp_list))
  1080.         (setq ai_lisp|*unnamed filter_lisp_list)
  1081.         (set_tile "named_lists" "0")
  1082.         (if (and (< 0 i) 
  1083.                  (and (= -4 (car (nth (1- i) filter_lisp_list)))   
  1084.                       (not (member (cdr (nth (1- i) filter_lisp_list)) 
  1085.                                   '("<AND" "AND>" "<OR"  "OR>" 
  1086.                                     "<XOR" "XOR>" "<NOT" "NOT>")
  1087.                            )
  1088.                       )
  1089.                  )
  1090.             )
  1091.           (progn
  1092.             (setq filter_lisp_list (rm_item (1- i) filter_lisp_list))
  1093.             (setq ai_lisp|*unnamed filter_lisp_list)
  1094.           )
  1095.         )
  1096.         (if (= 1 remove_flag)   ; only redisplay if remove, not with substitute
  1097.           (progn 
  1098.             (start_list "filter_str_list")
  1099.             (mapcar 'add_list filter_str_list)
  1100.             (end_list)
  1101.             ;; set highlight after removing item unless it's a blank list.
  1102.             (cond
  1103.               ((/= (1- (length filter_str_list)) str_pos)
  1104.                 (set_tile "filter_str_list" (itoa str_pos))
  1105.               )
  1106.               ((and (= (1- (length filter_str_list)) str_pos)
  1107.                     (/= 1 (length filter_str_list))
  1108.                )
  1109.                 (set_tile "filter_str_list" (itoa (1- str_pos)))
  1110.               )
  1111.               (T)
  1112.             )
  1113.           )
  1114.         )
  1115.       )
  1116.     )
  1117.   )
  1118.   ;;
  1119.   ;; Pass a number and a list and recieve the list back with that item missing.
  1120.   ;;
  1121.   (defun rm_item (value the_list)
  1122.     (setq temp_lisp_list '())
  1123.     (setq j 0)
  1124.     (foreach n the_list
  1125.       (if (/= value j)
  1126.         (setq temp_lisp_list (cons n temp_lisp_list))
  1127.       )
  1128.       (setq j (1+ j))
  1129.     )
  1130.     (setq temp_lisp_list (reverse temp_lisp_list))
  1131.   )
  1132.   ;;
  1133.   ;;  Get the fields of the highlighted item and place them in the edit area.
  1134.   ;;
  1135.   (defun do_edit()
  1136.     (setq edit_item (atoi (get_tile "filter_str_list")))  ;item in string list.
  1137.     (if (/= "" (nth edit_item filter_str_list)) 
  1138.       (progn 
  1139.         (setq i -1)
  1140.         (setq edit_this -1)        ; corresponding item in lisp list.
  1141.         (while (< edit_this edit_item)  ; until they are equal
  1142.           (setq i (1+ i))
  1143.           (if (not (and (= -4 (car (nth i filter_lisp_list)))  
  1144.                         (not (member (cdr (nth i filter_lisp_list)) 
  1145.                                     '("<AND" "AND>" "<OR"  "OR>"
  1146.                                       "<XOR" "XOR>" "<NOT" "NOT>")
  1147.                              )
  1148.                         )
  1149.                    )
  1150.               )
  1151.             (setq edit_this (1+ edit_this))   
  1152.           )
  1153.         )
  1154.         (setq gc_name (nth edit_item filter_str_list))
  1155.         (setq a 1)
  1156.         (while (/= "\t" (substr gc_name a 1))
  1157.           (setq a (1+ a))
  1158.         )
  1159.         (setq str_name (substr gc_name 1 (1- a)))
  1160.         (setq j 1)(setq ws nil)
  1161.         (cond 
  1162.           ((member (car (nth i filter_lisp_list)) '(-4 -3 1 2 3 6 7 8 38 39 40
  1163.                                                     41 43 44 45 48 50 51 62 66
  1164.                                                     70 71 10 11 12 13 14 15 
  1165.                                                     16 210))
  1166.             (set_tile "filter_by" 
  1167.                       (itoa (- (length filter_list) 
  1168.                                (length (member str_name filter_list))
  1169.                             )
  1170.                       )
  1171.             )
  1172.           )
  1173.           ((member (car (nth i filter_lisp_list)) '(0))
  1174.             ;; HACK  -- when the item is an Object, str_name is set to LINE
  1175.             ;; thereby forcing the correct fields to be disabled by 
  1176.             ;; (enable_disable).  This string does not need to be translated.
  1177.             ;; The alternative is to add a translatable string "Object" or
  1178.             ;; fix str_name to be the object name rather than "Object".
  1179.             (setq str_name "Line")
  1180.             (cond
  1181.               ((= "ATTDEF" (cdr (nth i filter_lisp_list)))
  1182.                 (set_tile "filter_by" 
  1183.                           (itoa (what_pos "Attribute" filter_list))
  1184.                 )
  1185.               )
  1186.               ((= "INSERT" (cdr (nth i filter_lisp_list)))
  1187.                 (set_tile "filter_by" (itoa (what_pos "Block" filter_list)))
  1188.               )
  1189.               ((= "MLINE" (cdr (nth i filter_lisp_list)))
  1190.                 (set_tile "filter_by" (itoa (what_pos "MultiLine" filter_list)))
  1191.               )
  1192.               ((= "3DSOLID" (cdr (nth i filter_lisp_list)))
  1193.                 (set_tile "filter_by" (itoa (what_pos "3D Solid" filter_list)))
  1194.               )
  1195.               ((= "*TEXT" (cdr (nth i filter_lisp_list)))
  1196.                 (set_tile "filter_by" (itoa (what_pos "Text" filter_list)))
  1197.               )
  1198.               (T
  1199.                 (set_tile "filter_by" 
  1200.                           (itoa (- (length filter_list)
  1201.                                    (length 
  1202.                                      (member 
  1203.                                        (strcat 
  1204.                                          (substr 
  1205.                                            (cdr (nth i filter_lisp_list)) 
  1206.                                            1 1
  1207.                                          )
  1208.                                          (strcase 
  1209.                                            (substr 
  1210.                                              (cdr (nth i filter_lisp_list)) 
  1211.                                              2
  1212.                                            ) 
  1213.                                            T
  1214.                                          )   
  1215.                                        )      
  1216.                                        filter_list
  1217.                                      )
  1218.                                    )
  1219.                                 )
  1220.                           )
  1221.                     )
  1222.                 )
  1223.             )
  1224.           )
  1225.           (T (princ "Error en la definici≤n de by_filter - c≤digo de grupo inexistente"))
  1226.         )
  1227.         (enable_disable str_name)
  1228.         (cond 
  1229.           ((member (car (nth i filter_lisp_list)) '(10 11 12 13 14 15 16))
  1230.             (set_tile "x_value" (ai_rtos (cadr (nth i filter_lisp_list))))
  1231.             (set_tile "y_value" (ai_rtos (caddr (nth i filter_lisp_list))))
  1232.             (set_tile "z_value" (ai_rtos (cadddr (nth i filter_lisp_list))))
  1233.             (setq ops_3 (cdr (nth (1- i) filter_lisp_list)))
  1234.             (setq j 1)
  1235.             (setq c1 nil) (setq c2 nil)
  1236.             (while (<= j (strlen ops_3))
  1237.               (cond 
  1238.                 ((and (= "," (substr ops_3 j 1))
  1239.                       (= nil c1)) 
  1240.                   (setq c1 j)
  1241.                 )
  1242.                 ((and (= "," (substr ops_3 j 1))
  1243.                       (/= nil c1)) 
  1244.                   (setq c2 j)
  1245.                 )
  1246.               )
  1247.               (setq j (1+ j))
  1248.             )
  1249.             (set_tile "x_op" 
  1250.                       (ai_rtos (- (length ri_ops) 
  1251.                                (length 
  1252.                                  (member (substr ops_3 1 (- c1 1)) ri_ops))
  1253.                                )
  1254.                       )
  1255.             ) 
  1256.             (set_tile "y_op" 
  1257.                       (ai_rtos (- (length ri_ops) 
  1258.                                (length 
  1259.                                  (member 
  1260.                                    (substr ops_3 (1+ c1) (1- (- c2 c1))) 
  1261.                                    ri_ops
  1262.                                  )
  1263.                                )
  1264.                             )
  1265.                       )        
  1266.             ) 
  1267.             (set_tile "z_op" 
  1268.                       (ai_rtos (- (length ri_ops) 
  1269.                                (length (member (substr ops_3 (1+ c2)) ri_ops))
  1270.                             )
  1271.                       )
  1272.             )  
  1273.           )
  1274.           ((member (car (nth i filter_lisp_list)) '(210))
  1275.             (set_tile "x_value" (ai_rtos (cadr (nth i filter_lisp_list))))
  1276.             (set_tile "y_value" (ai_rtos (caddr (nth i filter_lisp_list))))
  1277.             (set_tile "z_value" (ai_rtos (cadddr (nth i filter_lisp_list))))
  1278.             (set_tile "x_op" 
  1279.                       (ai_rtos (- (length ri_ops)
  1280.                                (length 
  1281.                                  (member 
  1282.                                    (cdr (nth (- i 1) filter_lisp_list)) 
  1283.                                    ri_ops
  1284.                                  )
  1285.                                )
  1286.                             )
  1287.                       )
  1288.             )   
  1289.           )
  1290.           ((member (car (nth i filter_lisp_list)) '(38 39 40 41 44 45 48 50 51))  
  1291.             (set_tile "x_value" (ai_rtos (cdr (nth i filter_lisp_list))))
  1292.             (set_tile "x_op" 
  1293.                       (ai_rtos (- (length ri_ops)
  1294.                                (length 
  1295.                                  (member 
  1296.                                    (cdr (nth (- i 1) filter_lisp_list)) 
  1297.                                    ri_ops
  1298.                                  )
  1299.                                )
  1300.                             )
  1301.                       )
  1302.             )          
  1303.           )
  1304.           ((member (car (nth i filter_lisp_list)) '(66 70 71))      ; integers
  1305.             (set_tile "x_value" (itoa (cdr (nth i filter_lisp_list))))
  1306.             (set_tile "x_op" 
  1307.                       (ai_rtos (- (length ri_ops)
  1308.                                (length 
  1309.                                  (member 
  1310.                                    (cdr (nth (- i 1) filter_lisp_list)) 
  1311.                                    ri_ops
  1312.                                  )
  1313.                                )
  1314.                             )
  1315.                       )
  1316.             )    
  1317.           )
  1318.           ((member (car (nth i filter_lisp_list)) '(62))      ;  Color
  1319.             (set_tile "x_value" (itoa (cdr (nth i filter_lisp_list))))
  1320.             (set_tile "x_op" 
  1321.                       (ai_rtos (- (length ri_ops)
  1322.                                (length 
  1323.                                  (member 
  1324.                                    (cdr (nth (- i 1) filter_lisp_list)) 
  1325.                                    ri_ops
  1326.                                  )
  1327.                                )
  1328.                             )
  1329.                       )
  1330.             )   
  1331.           )
  1332.           ((member (car (nth i filter_lisp_list)) '(2 3 5))    ; strings
  1333.             (set_tile "x_value" (cdr (nth i filter_lisp_list)))
  1334.           )
  1335.           ((member (car (nth i filter_lisp_list)) '(6 7 8))    ;  table strings
  1336.             (set_tile "x_value" (cdr (nth i filter_lisp_list)))
  1337.           )
  1338.           ((member (car (nth i filter_lisp_list)) '(-3))       ; xdata
  1339.             (set_tile "x_value" (caadr (nth i filter_lisp_list)))
  1340.           )
  1341.           ((member (car (nth i filter_lisp_list)) '(0))    ; 0 code is special
  1342.           )
  1343.           ((member (car (nth i filter_lisp_list)) '(-4))   ; -4 code is special
  1344.           )
  1345.         )
  1346.       )
  1347.     )
  1348.   )
  1349.   ;;
  1350.   ;; Clears the list.
  1351.   ;;
  1352.   (defun clear_list()
  1353.     (setq filter_lisp_list '())
  1354.     (setq filter_str_list '(""))
  1355.     (setq str_pos 0)
  1356.     (setq ai_lisp|*unnamed filter_lisp_list)
  1357.     (setq ai_str|*unnamed filter_str_list)
  1358.     (set_tile "named_lists" "0")
  1359.     (start_list "filter_str_list")
  1360.     (mapcar 'add_list filter_str_list)
  1361.     (end_list)
  1362.   )
  1363.   ;;
  1364.   ;;  Hide the dialogue, allow user selection of an entity, get the relevant
  1365.   ;;  information, translate to English, add both Lisp and English to relevant
  1366.   ;;  lists at current cursor position.
  1367.   ;;
  1368.   (defun get_entity()
  1369.     (setq entity_lisp '())
  1370.     (if (setq entity_ename (entsel))
  1371.       (progn
  1372.         (setq entity_lisp_init (cdr (entget (car entity_ename) (list "*"))))
  1373.         (setq entity_type (cdar entity_lisp_init))
  1374.         (cond 
  1375.           ((= entity_type "ARC")            (do_arc))
  1376.           ((= entity_type "BODY")           (do_body))
  1377.           ((= entity_type "CIRCLE")         (do_circle))
  1378.           ((= entity_type "DIMENSION")      (do_dimension))
  1379.           ((= entity_type "ELLIPSE")        (do_ellipse))
  1380.           ((= entity_type "INSERT")         (do_block))
  1381.           ((= entity_type "LEADER")         (do_leader))
  1382.           ((= entity_type "LINE")           (do_line))
  1383.           ((= entity_type "MLINE")          (do_mline))
  1384.           ((= entity_type "POINT")          (do_point))
  1385.           ((= entity_type "POLYLINE")       (do_polyline))
  1386.           ((= entity_type "RAY")            (do_ray))
  1387.           ((= entity_type "REGION")         (do_region))
  1388.           ((= entity_type "SHAPE")          (do_shape))
  1389.           ((= entity_type "SOLID")          (do_solid))
  1390.           ((= entity_type "3DSOLID")        (do_solids))
  1391.           ((= entity_type "SPLINE")         (do_spline))
  1392.           ((= entity_type "TEXT")           (do_text))
  1393.           ((= entity_type "MTEXT")          (do_text))
  1394.           ((= entity_type "ATTDEF")         (do_attdef))
  1395.           ((= entity_type "TOLERANCE")      (do_tolerance)) 
  1396.           ((= entity_type "TRACE")          (do_trace))
  1397.           ((= entity_type "3DFACE")         (do_3dface))
  1398.           ((= entity_type "VIEWPORT")       (do_viewport))
  1399.           ((= entity_type "XLINE")          (do_xline))
  1400.           (T (princ "\nObjeto no aceptado."))
  1401.         )
  1402.         (update (lts entity_lisp 0) entity_lisp_list)
  1403.       )
  1404.     )
  1405.   )
  1406.   ;;
  1407.   ;;  Arc
  1408.   ;;
  1409.   (defun do_arc()
  1410.     (foreach n entity_lisp_init
  1411.       (cond 
  1412.         ((= 0   (car n)) (group_0  "Arc"))
  1413.         ((= 8   (car n)) (group_8  "Layer"))
  1414.         ((= 6   (car n)) (group_8  "Linetype"))
  1415.         ((= 38  (car n)) (group_40 "Elevation"))
  1416.         ((= 39  (car n)) (group_40 "Thickness"))
  1417.         ((= 62  (car n)) (group_62 "Color"))
  1418.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1419.         ((= 10  (car n)) (group_10 "Arc Center"))
  1420.         ((= 40  (car n)) (group_40 "Arc Radius"))
  1421.         ((= 210 (car n)) (group_210)) 
  1422.         ((= -3  (car n)) (group_-3))
  1423.         (t)
  1424.       )
  1425.     )
  1426.   )
  1427.   ;;
  1428.   ;;  Attribute Definition.
  1429.   ;;
  1430.   (defun do_attdef()
  1431.     (foreach n entity_lisp_init
  1432.       (cond 
  1433.         ((= 0   (car n)) (group_0  "Attribute"))
  1434.         ((= 8   (car n)) (group_8  "Layer"))
  1435.         ((= 6   (car n)) (group_8  "Linetype"))
  1436.         ((= 38  (car n)) (group_40 "Elevation"))
  1437.         ((= 39  (car n)) (group_40 "Thickness"))
  1438.         ((= 62  (car n)) (group_62 "Color"))
  1439.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1440.         ((= 2   (car n)) (group_8  "Attribute Tag"))
  1441.         ((= 10  (car n)) (group_10 "Attribute Position"))
  1442.         ((= 210 (car n)) (group_210)) 
  1443.         ((= -3  (car n)) (group_-3))
  1444.       )
  1445.     )
  1446.   )
  1447.   ;;
  1448.   ;;  Insert Entity aka block
  1449.   ;;
  1450.   (defun do_block()
  1451.     (foreach n entity_lisp_init
  1452.       (cond 
  1453.         ((= 0   (car n)) (group_0  "Block"))
  1454.         ((= 8   (car n)) (group_8  "Layer"))
  1455.         ((= 6   (car n)) (group_8  "Linetype"))
  1456.         ((= 38  (car n)) (group_40 "Elevation"))
  1457.         ((= 39  (car n)) (group_40 "Thickness"))
  1458.         ((= 62  (car n)) (group_62 "Color"))
  1459.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1460.         ((= 2   (car n)) (group_8  "Block Name"))
  1461.         ((= 10  (car n)) (group_10 "Block Position"))
  1462.         ((= 50  (car n)) (group_50 "Block Rotation"))
  1463.         ((= 210 (car n)) (group_210)) 
  1464.         ((= -3  (car n)) (group_-3))
  1465.       )
  1466.     )
  1467.   )
  1468.   ;;
  1469.   ;; Circle
  1470.   ;;
  1471.   (defun do_circle()
  1472.     (foreach n entity_lisp_init
  1473.       (cond 
  1474.         ((= 0   (car n)) (group_0  "Circle"))
  1475.         ((= 8   (car n)) (group_8  "Layer"))
  1476.         ((= 6   (car n)) (group_8  "Linetype"))
  1477.         ((= 38  (car n)) (group_40 "Elevation"))
  1478.         ((= 39  (car n)) (group_40 "Thickness"))
  1479.         ((= 62  (car n)) (group_62 "Color"))
  1480.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1481.         ((= 10  (car n)) (group_10 "Circle Center"))
  1482.         ((= 40  (car n)) (group_40 "Circle Radius"))
  1483.         ((= 210 (car n)) (group_210)) 
  1484.         ((= -3  (car n)) (group_-3))
  1485.       )
  1486.     )
  1487.   )
  1488.   ;;
  1489.   ;;  Dimension
  1490.   ;;
  1491.   (defun do_dimension()
  1492.     (foreach n entity_lisp_init
  1493.       (cond 
  1494.         ((= 0   (car n)) (group_0  "Dimension"))
  1495.         ((= 8   (car n)) (group_8  "Layer"))
  1496.         ((= 6   (car n)) (group_8  "Linetype"))
  1497.         ((= 38  (car n)) (group_40 "Elevation"))
  1498.         ((= 62  (car n)) (group_62 "Color"))
  1499.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1500.         ((= 3   (car n)) (group_8   "Dimension Style"))
  1501.         ((= 210 (car n)) (group_210)) 
  1502.         ((= -3  (car n)) (group_-3))
  1503.       )
  1504.     )
  1505.   )
  1506.   ;;
  1507.   ;;  Ellipse
  1508.   ;;
  1509.   (defun do_ellipse()
  1510.     (foreach n entity_lisp_init
  1511.       (cond 
  1512.         ((= 0   (car n)) (group_0  "Ellipse"))
  1513.         ((= 8   (car n)) (group_8  "Layer"))
  1514.         ((= 6   (car n)) (group_8  "Linetype"))
  1515.         ((= 38  (car n)) (group_40 "Elevation"))
  1516.         ((= 62  (car n)) (group_62 "Color"))
  1517.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1518.         ((= 10  (car n)) (group_10 "Ellipse Center"))
  1519.         ((= 210 (car n)) (group_210)) 
  1520.         ((= -3  (car n)) (group_-3))
  1521.       )
  1522.     )
  1523.   )
  1524.   ;;
  1525.   ;;  Line
  1526.   ;;
  1527.   (defun do_line()
  1528.     (foreach n entity_lisp_init
  1529.       (cond 
  1530.         ((= 0   (car n)) (group_0  "Line"))
  1531.         ((= 8   (car n)) (group_8  "Layer"))
  1532.         ((= 6   (car n)) (group_8  "Linetype"))
  1533.         ((= 38  (car n)) (group_40 "Elevation"))
  1534.         ((= 39  (car n)) (group_40 "Thickness"))
  1535.         ((= 62  (car n)) (group_62 "Color"))
  1536.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1537.         ((= 10  (car n)) (group_10 "Line Start"))
  1538.         ((= 11  (car n)) (group_10 "Line End"))
  1539.         ((= 210 (car n)) (group_210)) 
  1540.         ((= -3  (car n)) (group_-3))
  1541.       )
  1542.     )
  1543.   )
  1544.   ;;
  1545.   ;;  MultiLine
  1546.   ;;
  1547.   (defun do_mline()
  1548.     (foreach n entity_lisp_init
  1549.       (cond 
  1550.         ((= 0   (car n)) (group_0  "MultiLine"))
  1551.         ((= 8   (car n)) (group_8  "Layer"))
  1552.         ((= 38  (car n)) (group_40 "Elevation"))
  1553.         ((= 62  (car n)) (group_62 "Color"))
  1554.         ((= 2   (car n)) (group_8  "MultiLine Style"))
  1555.         ((= 210 (car n)) (group_210)) 
  1556.         ((= -3  (car n)) (group_-3))
  1557.       )
  1558.     )
  1559.     (std_linetype)
  1560.   )
  1561.   ;;
  1562.   ;;  Point
  1563.   ;;
  1564.   (defun do_point()
  1565.     (foreach n entity_lisp_init
  1566.       (cond 
  1567.         ((= 0   (car n)) (group_0  "Point"))
  1568.         ((= 8   (car n)) (group_8  "Layer"))
  1569.         ((= 6   (car n)) (group_8  "Linetype"))
  1570.         ((= 38  (car n)) (group_40 "Elevation"))
  1571.         ((= 39  (car n)) (group_40 "Thickness"))
  1572.         ((= 62  (car n)) (group_62 "Color"))
  1573.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1574.         ((= 10  (car n)) (group_10 "Point Position"))
  1575.         ((= 210 (car n)) (group_210)) 
  1576.         ((= -3  (car n)) (group_-3))
  1577.       )
  1578.     )
  1579.   )
  1580.   ;;
  1581.   ;;  Polyline
  1582.   ;;
  1583.   (defun do_polyline()
  1584.     (foreach n entity_lisp_init
  1585.       (cond 
  1586.         ((= 0   (car n)) (group_0  "Polyline"))
  1587.         ((= 8   (car n)) (group_8  "Layer"))
  1588.         ((= 6   (car n)) (group_8  "Linetype"))
  1589.         ((= 38  (car n)) (group_40 "Elevation"))
  1590.         ((= 39  (car n)) (group_40 "Thickness"))
  1591.         ((= 62  (car n)) (group_62 "Color"))
  1592.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1593.         ((= 210 (car n)) (group_210)) 
  1594.         ((= -3  (car n)) (group_-3))
  1595.       )
  1596.     )
  1597.   )
  1598.   ;;
  1599.   ;;  Ray
  1600.   ;;
  1601.   (defun do_ray()
  1602.     (foreach n entity_lisp_init
  1603.       (cond 
  1604.         ((= 0   (car n)) (group_0  "Ray"))
  1605.         ((= 8   (car n)) (group_8  "Layer"))
  1606.         ((= 6   (car n)) (group_8  "Linetype"))
  1607.         ((= 38  (car n)) (group_40 "Elevation"))
  1608.         ((= 62  (car n)) (group_62 "Color"))
  1609.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1610.         ((= 210 (car n)) (group_210)) 
  1611.         ((= -3  (car n)) (group_-3))
  1612.       )
  1613.     )
  1614.     (std_color_linetype)
  1615.   )
  1616.   ;;
  1617.   ;;  Tolerance
  1618.   ;;
  1619.   (defun do_tolerance()
  1620.     (foreach n entity_lisp_init
  1621.       (cond 
  1622.         ((= 0   (car n)) (group_0  "Tolerance"))
  1623.         ((= 8   (car n)) (group_8  "Layer"))
  1624.         ((= 6   (car n)) (group_8  "Linetype"))
  1625.         ((= 38  (car n)) (group_40 "Elevation"))
  1626.         ((= 62  (car n)) (group_62 "Color"))
  1627.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1628.         ((= 210 (car n)) (group_210)) 
  1629.         ((= -3  (car n)) (group_-3))
  1630.       )
  1631.     )
  1632.     (std_color_linetype)
  1633.   )
  1634.   ;;
  1635.   ;;  Leader
  1636.   ;;
  1637.   (defun do_leader()
  1638.     (foreach n entity_lisp_init
  1639.       (cond 
  1640.         ((= 0   (car n)) (group_0  "Leader"))
  1641.         ((= 8   (car n)) (group_8  "Layer"))
  1642.         ((= 6   (car n)) (group_8  "Linetype"))
  1643.         ((= 38  (car n)) (group_40 "Elevation"))
  1644.         ((= 62  (car n)) (group_62 "Color"))
  1645.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1646.         ((= 210 (car n)) (group_210)) 
  1647.         ((= -3  (car n)) (group_-3))
  1648.       )
  1649.     )
  1650.     (std_color_linetype)
  1651.   )
  1652.   ;;
  1653.   ;;  Region
  1654.   ;;
  1655.   (defun do_region()
  1656.     (foreach n entity_lisp_init
  1657.       (cond 
  1658.         ((= 0   (car n)) (group_0  "Region"))
  1659.         ((= 8   (car n)) (group_8  "Layer"))
  1660.         ((= 6   (car n)) (group_8  "Linetype"))
  1661.         ((= 38  (car n)) (group_40 "Elevation"))
  1662.         ((= 62  (car n)) (group_62 "Color"))
  1663.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1664.         ((= 210 (car n)) (group_210)) 
  1665.         ((= -3  (car n)) (group_-3))
  1666.       )
  1667.     )
  1668.     (std_color_linetype)
  1669.   )
  1670.   ;;
  1671.   ;;  Shape
  1672.   ;;
  1673.   (defun do_shape()
  1674.     (foreach n entity_lisp_init
  1675.       (cond 
  1676.         ((= 0   (car n)) (group_0  "Shape"))
  1677.         ((= 8   (car n)) (group_8  "Layer"))
  1678.         ((= 6   (car n)) (group_8  "Linetype"))
  1679.         ((= 38  (car n)) (group_40 "Elevation"))
  1680.         ((= 39  (car n)) (group_40 "Thickness"))
  1681.         ((= 62  (car n)) (group_62 "Color"))
  1682.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1683.         ((= 10  (car n)) (group_10 "Shape Position"))
  1684.         ((= 2   (car n)) (group_8  "Shape Name"))
  1685.         ((= 210 (car n)) (group_210)) 
  1686.         ((= -3  (car n)) (group_-3))
  1687.       )
  1688.     )
  1689.   )
  1690.   ;;
  1691.   ;;  Solid
  1692.   ;;
  1693.   (defun do_solid()
  1694.     (foreach n entity_lisp_init
  1695.       (cond 
  1696.         ((= 0   (car n)) (group_0  "Solid"))
  1697.         ((= 8   (car n)) (group_8  "Layer"))
  1698.         ((= 6   (car n)) (group_8  "Linetype"))
  1699.         ((= 38  (car n)) (group_40 "Elevation"))
  1700.         ((= 39  (car n)) (group_40 "Thickness"))
  1701.         ((= 62  (car n)) (group_62 "Color"))
  1702.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1703.         ((= 210 (car n)) (group_210)) 
  1704.         ((= -3  (car n)) (group_-3))
  1705.       )
  1706.     )
  1707.   )
  1708.   ;;
  1709.   ;;  Solid Body
  1710.   ;;
  1711.   (defun do_solids()
  1712.     (foreach n entity_lisp_init
  1713.       (cond
  1714.         ((= 0   (car n)) (group_0  "3D Solid"))
  1715.         ((= 8   (car n)) (group_8  "Layer"))
  1716.         ((= 6   (car n)) (group_8  "Linetype"))
  1717.         ((= 38  (car n)) (group_40 "Elevation"))
  1718.         ((= 62  (car n)) (group_62 "Color"))
  1719.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1720.         ((= 210 (car n)) (group_210))
  1721.         ((= -3  (car n)) (group_-3))
  1722.       )
  1723.     )
  1724.     (std_color_linetype)
  1725.   )
  1726.   ;;
  1727.   ;;  Spline
  1728.   ;;
  1729.   (defun do_spline()
  1730.     (foreach n entity_lisp_init
  1731.       (cond
  1732.         ((= 0   (car n)) (group_0  "Spline"))
  1733.         ((= 8   (car n)) (group_8  "Layer"))
  1734.         ((= 6   (car n)) (group_8  "Linetype"))
  1735.         ((= 38  (car n)) (group_40 "Elevation"))
  1736.         ((= 62  (car n)) (group_62 "Color"))
  1737.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1738.         ((= 210 (car n)) (group_210))
  1739.         ((= -3  (car n)) (group_-3))
  1740.       )
  1741.     )
  1742.     (std_color_linetype)
  1743.   )
  1744.   ;;
  1745.   ;;  Text
  1746.   ;;
  1747.   (defun do_text()
  1748.     (foreach n entity_lisp_init
  1749.       (cond
  1750.         ((= 0   (car n)) (group_0  "Text"))
  1751.         ((= 8   (car n)) (group_8  "Layer"))
  1752.         ((= 6   (car n)) (group_8  "Linetype"))
  1753.         ((= 38  (car n)) (group_40 "Elevation"))
  1754.         ((= 39  (car n)) (group_40 "Thickness"))
  1755.         ((= 62  (car n)) (group_62 "Color"))
  1756.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1757.         ((= 10  (car n)) (group_10 "Text Position"))
  1758.         ((= 1   (car n)) (group_8  "Text Value"))
  1759.         ((= 7   (car n)) (group_8  "Text Style Name"))
  1760.         ((= 40  (car n)) (group_40 "Text Height"))
  1761.         ((= 50  (car n)) (group_50 "Text Rotation"))
  1762.         ((= 210 (car n)) (group_210))
  1763.         ((= -3  (car n)) (group_-3))
  1764.       )
  1765.     )
  1766.   )
  1767.   ;;
  1768.   ;;   Trace
  1769.   ;;
  1770.   (defun do_trace()
  1771.     (foreach n entity_lisp_init
  1772.       (cond
  1773.         ((= 0   (car n)) (group_0  "Trace"))
  1774.         ((= 8   (car n)) (group_8  "Layer"))
  1775.         ((= 6   (car n)) (group_8  "Linetype"))
  1776.         ((= 38  (car n)) (group_40 "Elevation"))
  1777.         ((= 39  (car n)) (group_40 "Thickness"))
  1778.         ((= 62  (car n)) (group_62 "Color"))
  1779.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1780.         ((= 210 (car n)) (group_210))
  1781.         ((= -3  (car n)) (group_-3))
  1782.       )
  1783.     )
  1784.   )
  1785.   ;;
  1786.   ;;   3Dface
  1787.   ;;
  1788.   (defun do_3dface()
  1789.     (foreach n entity_lisp_init
  1790.       (cond
  1791.         ((= 0   (car n)) (group_0  "3dface"))
  1792.         ((= 8   (car n)) (group_8  "Layer"))
  1793.         ((= 6   (car n)) (group_8  "Linetype"))
  1794.         ((= 38  (car n)) (group_40 "Elevation"))
  1795.         ((= 62  (car n)) (group_62 "Color"))
  1796.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1797.         ((= 210 (car n)) (group_210))
  1798.         ((= -3  (car n)) (group_-3))
  1799.       )
  1800.     )
  1801.     (std_color_linetype)
  1802.   )
  1803.   ;;
  1804.   ;;  Viewport
  1805.   ;;
  1806.   (defun do_viewport()
  1807.     (foreach n entity_lisp_init
  1808.       (cond
  1809.         ((= 0   (car n)) (group_0  "Viewport"))
  1810.         ((= 8   (car n)) (group_8  "Layer"))
  1811.         ((= 38  (car n)) (group_40 "Elevation"))
  1812.         ((= 39  (car n)) (group_40 "Thickness"))
  1813.         ((= 62  (car n)) (group_62 "Color"))
  1814.         ((= 10  (car n)) (group_10 "Viewport Center"))
  1815.         ((= 210 (car n)) (group_210))
  1816.         ((= -3  (car n)) (group_-3))
  1817.       )
  1818.     )
  1819.   )
  1820.   ;;
  1821.   ;;  XLine
  1822.   ;;
  1823.   (defun do_xline()
  1824.     (foreach n entity_lisp_init
  1825.       (cond
  1826.         ((= 0   (car n)) (group_0  "Xline"))
  1827.         ((= 8   (car n)) (group_8  "Layer"))
  1828.         ((= 6   (car n)) (group_8  "Linetype"))
  1829.         ((= 38  (car n)) (group_40 "Elevation"))
  1830.         ((= 62  (car n)) (group_62 "Color"))
  1831.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1832.         ((= 210 (car n)) (group_210))
  1833.         ((= -3  (car n)) (group_-3))
  1834.       )
  1835.     )
  1836.     (std_color_linetype)
  1837.   )
  1838.   ;;
  1839.   ;;  Body
  1840.   ;;
  1841.   (defun do_body()
  1842.     (foreach n entity_lisp_init
  1843.       (cond
  1844.         ((= 0   (car n)) (group_0  "Body"))
  1845.         ((= 8   (car n)) (group_8  "Layer"))
  1846.         ((= 6   (car n)) (group_8  "Linetype"))
  1847.         ((= 38  (car n)) (group_40 "Elevation"))
  1848.         ((= 62  (car n)) (group_62 "Color"))
  1849.         ((= 48  (car n)) (group_40 "Linetype Scale"))
  1850.         ((= 210 (car n)) (group_210))
  1851.         ((= -3  (car n)) (group_-3))
  1852.       )
  1853.     )
  1854.     (std_color_linetype)
  1855.   )
  1856.   ;;
  1857.   ;;   Group code 0
  1858.   ;;
  1859.   (defun group_0(label)
  1860.     (setq entity_lisp (cons (list "Objeto \t\t=\t" (en_to_loc label)) entity_lisp))
  1861.     (setq entity_lisp_list (list n))
  1862.     ;; Added for MText and Text equivalancy.
  1863.     (if (or (= label "Text") (= label "MText")) 
  1864.       (setq entity_lisp_list (list (cons '0 "*Text")))
  1865.     ) 
  1866.   )
  1867.   ;;
  1868.   ;;   Strings
  1869.   ;;
  1870.   (defun group_8(label)
  1871.     (setq entity_lisp (cons (list (en_to_loc label) "\t\t=\t" (cdr n)) entity_lisp))
  1872.     (setq entity_lisp_list (reverse (cons n (reverse entity_lisp_list))))
  1873.   )
  1874.   ;;
  1875.   ;;   Coordinate
  1876.   ;;
  1877.   (defun group_10(label)
  1878.     (if (not (assoc 6 entity_lisp_list))
  1879.       (progn 
  1880.         (setq entity_lisp 
  1881.               (cons (list "Tipolφnea\t\t=\t" "PORCAPA") entity_lisp)
  1882.         )
  1883.         (setq entity_lisp_list 
  1884.               (reverse (cons (cons 6 "BYLAYER") (reverse entity_lisp_list)))
  1885.         )
  1886.       )
  1887.     )
  1888.     (if (not (assoc 62 entity_lisp_list))
  1889.       (progn 
  1890.         (setq entity_lisp (cons (list "Color\t\t=\t" "PORCAPA") entity_lisp))
  1891.         (setq entity_lisp_list 
  1892.               (reverse (cons 
  1893.                          (cons 62 256) 
  1894.                          (cons (cons -4 "=") (reverse entity_lisp_list))
  1895.                        )
  1896.                )
  1897.         )
  1898.       )
  1899.     )
  1900.     (setq entity_lisp (cons (list (en_to_loc label)
  1901.                                    "\tX\t=\t" (ai_rtos (cadr n))
  1902.                                    "\tY\t=\t" (ai_rtos (caddr n))
  1903.                                    "\tZ\t=\t" (ai_rtos (cadddr n))
  1904.                              )
  1905.                              entity_lisp))
  1906.     (setq entity_lisp_list 
  1907.           (reverse 
  1908.             (cons n (cons (cons -4 "=,=,=") (reverse entity_lisp_list)))
  1909.           )
  1910.     )
  1911.   )
  1912.   ;;
  1913.   ;;   Reals
  1914.   ;;
  1915.   (defun group_40(label)
  1916.     (setq entity_lisp (cons (list (en_to_loc label) "\t\t=\t" (ai_rtos (cdr n))) entity_lisp))
  1917.     (setq entity_lisp_list 
  1918.           (reverse (cons n (cons (cons -4 "=") (reverse entity_lisp_list))))
  1919.     )
  1920.   )
  1921.   ;;
  1922.   ;;   Reals
  1923.   ;;
  1924.   (defun group_50(label)
  1925.     (setq entity_lisp (cons (list (en_to_loc label) "\t\t=\t" (ai_angtos (cdr n))) entity_lisp))
  1926.     (setq entity_lisp_list 
  1927.           (reverse (cons n (cons (cons -4 "=") (reverse entity_lisp_list))))
  1928.     )
  1929.   )
  1930.   ;;
  1931.   ;;   Color
  1932.   ;;
  1933.   (defun group_62(label / str)
  1934.     (setq str (cdr n))
  1935.     (cond 
  1936.       ((= 0 str)   (setq str "0 - Por Bloque"))
  1937.       ((= 1 str)   (setq str "1 - Rojo"))
  1938.       ((= 2 str)   (setq str "2 - Amarillo"))
  1939.       ((= 3 str)   (setq str "3 - Verde"))
  1940.       ((= 4 str)   (setq str "4 - Ciano"))
  1941.       ((= 5 str)   (setq str "5 - Azul"))
  1942.       ((= 6 str)   (setq str "6 - Magenta"))
  1943.       ((= 7 str)   (setq str "7 - Blanco"))
  1944.       ((= 256 str) (setq str "256 - Por Capa"))
  1945.       (t (setq str (itoa str)))
  1946.     )
  1947.     (setq entity_lisp (cons (list (en_to_loc label) "\t\t=\t" str) entity_lisp))
  1948.     (setq entity_lisp_list 
  1949.           (reverse (cons n (cons (cons -4 "=") (reverse entity_lisp_list))))
  1950.     )
  1951.   )
  1952.   ;;
  1953.   ;;   Normal Vector
  1954.   ;;
  1955.   (defun group_210()
  1956.     (if (not (assoc 6 entity_lisp_list))
  1957.       (progn 
  1958.         (setq entity_lisp 
  1959.               (cons (list "Tipolφnea\t\t=\t" "PORCAPA") entity_lisp)
  1960.         )
  1961.         (setq entity_lisp_list 
  1962.               (reverse (cons (cons 6 "BYLAYER") (reverse entity_lisp_list)))
  1963.         )
  1964.       )
  1965.     )
  1966.     (if (not (assoc 62 entity_lisp_list))
  1967.       (progn 
  1968.         (setq entity_lisp (cons (list "Color\t\t=\t" "PORCAPA") entity_lisp))
  1969.         (setq entity_lisp_list (reverse (cons (cons 62 256) (cons (cons -4 "=") (reverse entity_lisp_list)))))
  1970.       ) 
  1971.     )
  1972.     (setq entity_lisp (cons (list "Vector normal" 
  1973.                                    "\tX\t=\t" (ai_rtos (cadr n))
  1974.                                    "\tY\t=\t" (ai_rtos (caddr n))
  1975.                                    "\tZ\t=\t" (ai_rtos (cadddr n))
  1976.                              )
  1977.                              entity_lisp))
  1978.     (setq entity_lisp_list 
  1979.           (reverse (cons n (cons (cons -4 "=") (reverse entity_lisp_list))))
  1980.     )
  1981.   )
  1982.   ;;
  1983.   ;;    Xdata ID
  1984.   ;;
  1985.   (defun group_-3()
  1986.     (setq appid_str "")
  1987.     (if (< 1 (length n)) 
  1988.       (progn 
  1989.         (foreach n1 (cdr n) 
  1990.           (setq appid_str (strcat (car n1) "," appid_str))
  1991.         )
  1992.         (setq appid_str (substr appid_str 1 (1- (strlen appid_str))))
  1993.         (setq entity_lisp (subst (list "ID Xdata \t\t=\t" appid_str) 
  1994.                                  n 
  1995.                                  entity_lisp
  1996.                           )
  1997.         )
  1998.         (setq entity_lisp_list 
  1999.               (reverse 
  2000.                 (cons (list -3 (list appid_str)) (reverse entity_lisp_list))
  2001.               )
  2002.         )
  2003.       )
  2004.     )
  2005.   )
  2006.   ;;
  2007.   ;; Addition of default color and linetype.  Used in group_10 and group_210
  2008.   ;;
  2009.   (defun std_color_linetype()
  2010.     (if (not (assoc 6 entity_lisp_list))
  2011.       (progn 
  2012.         (setq entity_lisp 
  2013.               (cons (list "Tipolφnea\t\t=\t" "PORCAPA") entity_lisp)
  2014.         )
  2015.         (setq entity_lisp_list 
  2016.               (reverse (cons (cons 6 "BYLAYER") (reverse entity_lisp_list)))
  2017.         )
  2018.       )
  2019.     )
  2020.     (if (not (assoc 62 entity_lisp_list))
  2021.       (progn 
  2022.         (setq entity_lisp (cons (list "Color\t\t=\t" "PORCAPA") entity_lisp))
  2023.         (setq entity_lisp_list 
  2024.               (reverse (cons 
  2025.                          (cons 62 256) 
  2026.                          (cons (cons -4 "=") (reverse entity_lisp_list))
  2027.                        )
  2028.                )
  2029.         )
  2030.       )
  2031.     )
  2032.   )
  2033.   ;;
  2034.   ;; Addition of default linetype.  Used by MLine.
  2035.   ;;
  2036.   (defun std_linetype()
  2037.     (if (not (assoc 6 entity_lisp_list))
  2038.       (progn 
  2039.         (setq entity_lisp 
  2040.               (cons (list "Tipolφnea\t\t=\t" "PORCAPA") entity_lisp)
  2041.         )
  2042.         (setq entity_lisp_list 
  2043.               (reverse (cons (cons 6 "BYLAYER") (reverse entity_lisp_list)))
  2044.         )
  2045.       )
  2046.     )
  2047.   )
  2048.   ;;
  2049.   ;; Changes list of lists to list of strings, if bit_flag = 1 return parens.
  2050.   ;;
  2051.   (defun lts (the_list bit_flag / n n1 dp1 dp2)       
  2052.     (setq list_str '())       ; for display in list box.
  2053.     (foreach n the_list 
  2054.       (cond
  2055.         ((= -3 (car n)) 
  2056.           (setq str (strcat "( -3" "(" "\"" (caadr n) "\"" "))" ))
  2057.         )
  2058.         ((/= (type (cdr n)) 'LIST)     ; is it a dotted pair or a list.
  2059.           (setq str "")
  2060.           (setq dp1 (what_is_it (car n)))  ; broken out for clarity.
  2061.           (setq dp2 (what_is_it (cdr n)))
  2062.           ; cdrs are strings except for color, elevation, and thickness
  2063.           (if (member (car n) '(38 39 40 41 42 43 48 50 51 62))
  2064.             (setq str (strcat "(" dp1 " . " dp2 ")"))
  2065.             (setq str (strcat "(" dp1 " . " "\"" dp2 "\""  ")"))
  2066.           )
  2067.         )
  2068.         (T
  2069.           (setq str "")
  2070.           (cond 
  2071.             ((= 1 bit_flag)
  2072.               (foreach n1 n
  2073.                 (setq str (strcat str (what_is_it n1) " "))
  2074.               )
  2075.             )
  2076.             ((= 0 bit_flag)
  2077.               (foreach n1 n
  2078.                 (setq str (strcat str (what_is_it n1)))
  2079.               )
  2080.             )
  2081.           )
  2082.           ; get rid of last white space
  2083.           (if (= 1 bit_flag)
  2084.             (setq str (strcat "(" (substr str 1 (- (strlen str) 1)) ")" ))
  2085.           )
  2086.         )
  2087.       )
  2088.       (setq list_str (cons str list_str))   
  2089.     )
  2090.   )
  2091.   ;;
  2092.   ;;  What type is it ?? 
  2093.   ;;
  2094.   (defun what_is_it (huh / hmmm)
  2095.     (cond  
  2096.       ((= (type huh) 'INT)  (setq hmmm (itoa huh)))
  2097.       ((= (type huh) 'REAL) (setq hmmm (rtos huh 2 15)))
  2098.       ((= (type huh) 'STR)  (setq hmmm huh ))
  2099.     ) 
  2100.     hmmm      
  2101.   )    
  2102.   ;;
  2103.   ;; Check Lisp list for errors.
  2104.   ;;
  2105.   (defun lisp_error(/ after_errno temp_ss)
  2106.     (setq temp_ss (ssget "_X" filter_lisp_list))
  2107.     (setq after_errno (getvar "errno"))
  2108.     (cond
  2109.       ((= 56 after_errno) 
  2110.         (set_tile "error" "Lista de filtros no vßlida - Fin prematuro.")
  2111.       )
  2112.       ((= 57 after_errno) 
  2113.         (set_tile "error" "Lista de filtros no vßlida - Operando de test inexistente.")
  2114.       )
  2115.        ((= 58 after_errno) 
  2116.        (set_tile "error" "Lista de filtros no vßlida - Cadena op_code no vßlida.")
  2117.       )
  2118.       ((= 59 after_errno) 
  2119.         (set_tile "error" "Lista de filtros no vßlida - Clßusula vacφa/anidaci≤n no conveniente.")
  2120.       )
  2121.       ((= 60 after_errno) 
  2122.         (set_tile "error" "Lista de filtros no vßlida - Clßusula inicio/fin no coincidente.")
  2123.       )
  2124.       ((= 61 after_errno) 
  2125.         (set_tile "error" 
  2126.                   "Lista de filtros no vßlida - N·mero de operandos de XOR/NOT err≤neo."
  2127.         )
  2128.       )
  2129.       ((= 62 after_errno) 
  2130.         (set_tile "error" "Lista de filtros no vßlida - Mßxima anidaci≤n excedida.")
  2131.       )
  2132.       ((= 63 after_errno) 
  2133.         (set_tile "error" "Lista de filtros no vßlida - C≤digo de grupo no vßlido.")
  2134.       )
  2135.       ((= 64 after_errno) 
  2136.         (set_tile "error" "Lista de filtros no vßlida - Test de cadena no vßlido.")
  2137.       )
  2138.       ((= 65 after_errno) 
  2139.         (set_tile "error" "Lista de filtros no vßlida - Prueba de vectores no vßlida.")
  2140.       )
  2141.       ((= 66 after_errno) 
  2142.         (set_tile "error" "Lista de filtros no vßlida - Prueba de n║ reales no vßlida.")
  2143.       )
  2144.       ((= 67 after_errno) 
  2145.         (set_tile "error" "Lista de filtros no vßlida - Prueba de n║ enteros no vßlida.")
  2146.       )
  2147.       (t nil)
  2148.     )
  2149.   )
  2150.   ;;
  2151.   ;; Puts up dialogue for table selection, returns a list of strings on OK and
  2152.   ;; nil on Cancel.
  2153.   ;;
  2154.   (defun single_table (table_name title / pat what_next selection_list)
  2155.     (if (not (new_dialog "single_table" dcl_id)) (exit))
  2156.     (setq table_list (ai_table table_name 8)) ; List items in specified table.
  2157.     (setq pat "*")                ; Set pattern to all items initially.
  2158.     (set_tile "pattern" pat)        ; Set the pattern to *.
  2159.     (set_tile "title" title)  ; Set the dialogue title to whatever.
  2160.     (pat_match pat "table_match")   
  2161.  
  2162.     ;; Define what happens when each button is pressed.
  2163.     (action_tile "pattern" 
  2164.                  "(pat_match (setq pat (xstrcase $value)) \"table_match\")")
  2165.  
  2166.     (action_tile "table_match" "(make_list)")
  2167.     ;; return the selection_list on OK.
  2168.     (setq what_next (start_dialog))
  2169.     (if (= 1 what_next) selection_list nil)  ; return list on OK
  2170.   )
  2171.   ;;
  2172.   ;; Add to Selection List.
  2173.   ;;
  2174.   (defun make_list (/ item_index string temp_list a)
  2175.     (setq selection_list '())     ; initialise list
  2176.     (setq string (get_tile "table_match"))
  2177.     (setq a 0)
  2178.     (while (/= (read string) nil)
  2179.       (setq item_index (itoa (read string))) 
  2180.       (setq string (substr string (+ 2 (strlen item_index))))
  2181.       (setq selection_list 
  2182.              (cons (nth (atoi item_index) table_match) selection_list))
  2183.       (setq a (1+ a))
  2184.     )
  2185.     (setq selection_list (reverse selection_list))
  2186. ;;  Commented out as table_name is not always in the english list.  It's OK
  2187. ;;  for items such as LAYER whose english name is the same as AutoCAD's 
  2188. ;;  internal name, but that's not the case for Dimension Style etc.  The
  2189. ;;  easiest fix is to remove GCCLOC for the message string and just have
  2190. ;;  a message like "1 selected" but it's too late to remove the (s).  So
  2191. ;;  no message is posted.
  2192. ;   (setq GCCLOC (en_to_loc table_name))
  2193. ;   (set_tile "error" (strcat (itoa a) " " GCCLOC ;|FILTER_LSP_71|;"(s) selected."))
  2194.   )
  2195.   ;;
  2196.   ;; This function displays the table list based on the pattern.
  2197.   ;;
  2198.   (defun pat_match (pat which_box / which_list a)
  2199.     (setq which_list '())
  2200.     (setq a 0)
  2201.     (foreach n table_list 
  2202.       (if (wcmatch n pat) 
  2203.         (progn 
  2204.           (setq which_list (cons n which_list))
  2205.         )
  2206.       )
  2207.       (setq a (1+ a))
  2208.     )    
  2209.     ;; Alphabetize the matched list.
  2210.     (if (and which_list 
  2211.              (< (length which_list) (getvar "maxsort"))
  2212.         )
  2213.       (setq which_list (acad_strlsort which_list))
  2214.     ) 
  2215.     (start_list which_box)
  2216.     (mapcar 'add_list which_list)
  2217.     (end_list)
  2218.     (set (read (eval which_box)) which_list)
  2219.   )
  2220.   ;;
  2221.   ;; If an error occurs on reading filter.nfl, it is due to a syntax error 
  2222.   ;; introduced by someone editing the file.   
  2223.   ;;
  2224.   (defun load_error (s)                     
  2225.     (princ "\nError de sintaxis en el archivo de filtros con nombre. Borre filter.nfl.")
  2226.     (if filter_nfl (close filter_nfl))
  2227.     (if old_error (setq *error* old_error))   ; Restore old *error* handler
  2228.     (princ)
  2229.   )
  2230.  
  2231.   ;; 
  2232.   ;; Put up the dialogue.
  2233.   ;;
  2234.   (defun filter_main()
  2235.  
  2236.     ;; Set up error function.
  2237.     (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  2238.           old_error  *error*            ; save current error function
  2239.           *error* load_error              ; new error function
  2240.     )
  2241.  
  2242.     (setvar "cmdecho" 0)
  2243.  
  2244.     (setq str_pos           nil
  2245.           what_next         3
  2246.           filter_str_list   '("")
  2247.           filter_lisp_list  '()
  2248.           all_lisp_list     '("*s-nombre")
  2249.     )
  2250.     (load_log)     ; if there is a file containing named filter lists, load it.
  2251.  
  2252.     (setq *error* ai_error)  ; After loading reset error to normal error.
  2253.  
  2254.     (init_lists)   ; initialise the big lists.
  2255.     (init_lists_english)   ; This is the initialization of English keywords. Added for loc.
  2256.  
  2257.     (while (< 1 what_next)             ; loop for hiding dialogue.
  2258.       (if (not (new_dialog "filter" dcl_id)) (exit))
  2259.       (set_tile "x_value" "0.0000")   ; some default values
  2260.       (set_tile "y_value" "0.0000")
  2261.       (set_tile "z_value" "0.0000")
  2262.       (mode_tile "x_text" 1)(mode_tile "y_text" 1)(mode_tile "z_text" 1)
  2263.       (mode_tile "x_op" 1) (mode_tile "x_value" 1)
  2264.       (mode_tile "y_op" 1) (mode_tile "y_value" 1)
  2265.       (mode_tile "z_op" 1) (mode_tile "z_value" 1)
  2266.       (mode_tile "select" 1)
  2267.  
  2268.       (start_list "filter_by")           ; the list of possible filters
  2269.       (mapcar 'add_list filter_list)
  2270.       (end_list)
  2271.  
  2272.       (start_list "filter_str_list")     ; the list of chosen filters
  2273.       (mapcar 'add_list filter_str_list)
  2274.       (end_list)
  2275.  
  2276.       (start_list "named_lists")         ; the list of named filter lists
  2277.       (mapcar 'add_list all_lisp_list)
  2278.       (end_list)
  2279.     
  2280.       (start_list "x_op")                ; the list of X coordinate filters
  2281.       (mapcar 'add_list ri_ops)
  2282.       (end_list)
  2283.  
  2284.       (start_list "y_op")
  2285.       (mapcar 'add_list ri_ops)          ; the list of Y coordinate filters
  2286.       (end_list)
  2287.  
  2288.       (start_list "z_op")                ; the list of Z coordinate filters
  2289.       (mapcar 'add_list ri_ops)
  2290.       (end_list)
  2291.    
  2292.       (if (not str_pos) (setq str_pos 0)) ; position within string list
  2293.  
  2294.       (if (not pick)                   ; current selection in possible filters
  2295.         (progn 
  2296.           (setq pick "Arc")
  2297.           (set_tile "filter_by" "0")
  2298.         )
  2299.         (progn 
  2300.           (set_tile "filter_by" (itoa (what_pos pick filter_list)))
  2301.           (grey_filter)
  2302.         )
  2303.       )
  2304.       ;; Get the default named list from ai_defaults.
  2305.       (if (and (= 3 what_next)
  2306.                (setq last_name (cadr (assoc "filter" ai_defaults)))
  2307.           )
  2308.         (progn
  2309.           (if (not (member last_name all_lisp_list))  ; may no longer exist.
  2310.             (setq last_name "*unnamed")
  2311.           )
  2312.           ;; Localization fix
  2313.           (if (= last_name "*s-nombre") 
  2314.                (setq last_name "*unnamed")
  2315.           )
  2316.           (setq pick_list (what_pos last_name all_lisp_list))
  2317.           (set_tile "named_lists" (itoa pick_list))
  2318.           (setq filter_str_list (eval (read (strcat "ai_str|" last_name))))
  2319.           (setq filter_lisp_list (eval (read (strcat "ai_lisp|" last_name))))
  2320.           (start_list "filter_str_list")
  2321.           (mapcar 'add_list filter_str_list)
  2322.           (end_list)
  2323.         )
  2324.         (progn
  2325.           (setq pick_list 0)
  2326.           (set_tile "named_lists" "0") 
  2327.           (setq last_name "*unnamed")
  2328.         )
  2329.       )
  2330.  
  2331.       (set_tile "filter_str_list" (itoa str_pos))
  2332.  
  2333.       (action_tile "filter_str_list" "(rs_err)(setq str_pos (atoi $value))")
  2334.       (action_tile "select_entity"   "(rs_err)(do_select_entity)")
  2335.       (action_tile "edit"            "(rs_err)(do_edit)")
  2336.       (action_tile "clear_list"      "(rs_err)(clear_list)")
  2337.       (action_tile "remove"          "(rs_err)(do_remove)")
  2338.       (action_tile "filter_by"       "(rs_err)(grey_filter)")
  2339.       (action_tile "select"          "(rs_err)(select)")
  2340.       (action_tile "add_to_list"     "(rs_err)(add_to_list)")
  2341.       (action_tile "substitute"      "(rs_err)(remove)(add_to_list)")
  2342.       (action_tile "apply"           "(if (not (lisp_error))(done_dialog 1))")
  2343.       (action_tile "save_as"         "(rs_err)(save_as)")
  2344.       (action_tile "named_lists"     "(rs_err)(named_lists)")
  2345.       (action_tile "delete_list"     "(rs_err)(delete_list)")
  2346.       (action_tile "help"            "(help \"\" \"filter\")")
  2347.  
  2348.       (setq what_next (start_dialog))
  2349.       (if (= 2 what_next) (get_entity))
  2350.     )    
  2351.     (if (= 1 what_next) 
  2352.       (progn
  2353.         ;; Use this name as the default next time.
  2354.         (if (not list_name) (setq list_name "*unnamed"))
  2355.         (if (assoc "filter" ai_defaults)
  2356.           (setq ai_defaults (subst (list "filter" list_name) 
  2357.                                    (assoc "filter" ai_defaults)
  2358.                                    ai_defaults
  2359.                             )
  2360.           )
  2361.           (setq ai_defaults (cons (list "filter" list_name) ai_defaults))
  2362.         )
  2363.         (princ "\nAplicando filtro a la selecci≤n.  ")
  2364.         (setq ret_list (ssget filter_lisp_list))
  2365.         (princ "\nSaliendo de la selecci≤n por filtros.  ")
  2366.       )
  2367.     )
  2368.     (foreach n all_lisp_list      ; set all named lists to nil
  2369.       (if (/= n "*s-nombre")
  2370.         (progn 
  2371.           (set (read (strcat "ai_str|" n)) nil)
  2372.           (set (read (strcat "ai_lisp|" n)) nil)
  2373.         )
  2374.       )
  2375.     )
  2376.     (setq *error* old_error) 
  2377.     (setvar "cmdecho" old_cmd)
  2378.   )
  2379.  
  2380.   (cond
  2381.      (  (not (ai_transd)))                       ; transparent OK
  2382.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  2383.      (  (not (setq dcl_id (ai_dcl "filter"))))  ; is .DCL file loaded?
  2384.      (t (filter_main))                          ; proceed!
  2385.   )
  2386.  
  2387.   ;; Return the list is there is a command active, else exit quietly.
  2388.   (if (and (/= 0 (getvar "cmdactive"))
  2389.            (= 1 what_next)
  2390.       )
  2391.     ret_list
  2392.     (princ)
  2393.   )
  2394. )
  2395.  
  2396.  
  2397. ;;;
  2398. ;;;  New modules to make the lisp routine language independent by only
  2399. ;;;  translating the first list.
  2400. ;;;  Do not touch the order of the list or TRANSLATE. This part should
  2401. ;;;  remain as it is.
  2402. ;;;  Have fun.
  2403. ;;;
  2404. (defun loc_to_en(palab / engl)
  2405.     (setq where (what_pos palab filter_list))
  2406.         (setq engl (nth where filter_list_english))
  2407. )
  2408.  
  2409. (defun en_to_loc(palab / loc)
  2410.         (setq where (what_pos palab filter_list_english))
  2411.         (setq loc (nth where filter_list))
  2412. )
  2413.  
  2414. (defun init_lists_english()
  2415.     (setq filter_list_english (list 
  2416.                         "Arc"          "Arc Center"         "Arc Radius"
  2417.                         "Attribute"    "Attribute Position" "Attribute Tag" 
  2418.                         "Body"
  2419.                         "Block"        "Block Name"         "Block Position"
  2420.                                        "Block Rotation"
  2421.                         "Circle"       "Circle Center"      "Circle Radius" 
  2422.                         "Color"         
  2423.                         "Dimension"    "Dimension Style" 
  2424.                         "Elevation"     
  2425.                         "Ellipse"      "Ellipse Center"
  2426.                         "Layer"
  2427.                         "Leader"
  2428.                         "Line"         "Line Start"         "Line End"
  2429.                         "Linetype"
  2430.                         "Linetype Scale"
  2431.                         "MultiLine"    "MultiLine Style"
  2432.                         "Normal Vector"
  2433.                         "Point"        "Point Position"
  2434.                         "Polyline"      
  2435.                         "Ray"
  2436.                         "Region"
  2437.                         "Shape"        "Shape Position"     "Shape Name"                                            
  2438.                         "Solid"
  2439.                         "3D Solid"
  2440.                         "Spline"
  2441.                         "Text"         "Text Position"      "Text Value"
  2442.                                        "Text Style Name"    "Text Height" 
  2443.                                        "Text Rotation"
  2444.                         "Trace"
  2445.                         "3dface"
  2446.                         "Thickness"
  2447.                         "Tolerance"
  2448.                         "Viewport"     "Viewport Center" 
  2449.                         "Xdata ID"
  2450.                         "Xline"
  2451.                         "** Begin  AND"
  2452.                         "** End    AND"
  2453.                         "** Begin  OR"
  2454.                         "** End    OR"
  2455.                         "** Begin  XOR"
  2456.                         "** End    XOR"
  2457.                         "** Begin  NOT"
  2458.                         "** End    NOT"
  2459.                   )
  2460.     )
  2461. )
  2462. ;;;----------------------------------------------------------------------------
  2463. (princ "  FILTER cargado.  ")
  2464. (princ)
  2465.  
  2466.