home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_EINF.LSP < prev    next >
Lisp/Scheme  |  1997-12-01  |  15KB  |  354 lines
  1. ;;; FLX_EINF.LSP  
  2. ;;; ======================================================================
  3. ;;; (C)opyright Felix Computer Aided Technologies GmbH 1996-97
  4. ;;; Sept 30, 1996 / dn,vp
  5. ;;; Dec. 01, 1997 / modified vp
  6. ;;; ======================================================================
  7. ;;; ENTITY INFO
  8. ;;; ======================================================================
  9.  
  10. (defun FLX_EINFO ( / dialog_title prt_list point2s 
  11.                   MELIST GET_VERTEX GET_ATTRIB LENGTH_of_LINE LENGTH_of_ARC  
  12.                   DlgInit SEPARATOR ew el n p1 ent_list lst flag tmp as i 
  13.                   as_length)
  14.  
  15.   ;;; Error Handler
  16.  
  17.   (FLX_FUNC_INIT)
  18.  
  19.   ;;; Dialog Title and Prompt List
  20.  
  21.   (setq dialog_title "ENTITY INFORMATION")
  22.   
  23.   (setq prt_list (list
  24.     "Type: \t"
  25.     "Layer: \t" 
  26.     "Line type: \t" 
  27.     "Layer's line type"
  28.     "Color: \t"
  29.     "Layer's color"
  30.     "Part definition color"
  31.     "Layer's color"
  32.     "Handle ID: \t"
  33.     "Start point: \t" 
  34.     "End point: \t" 
  35.     "Length: \t"
  36.     "Center: \t"  
  37.     "Radius: \t"  
  38.     "Start angle: \t"  
  39.     "End angle: \t"  
  40.     "Arc length: \t"  
  41.     "Coordinates:\t" 
  42.     "Corner 1: \t"
  43.     "Corner 2: \t"
  44.     "Corner 3: \t"
  45.     "Corner 4: \t"
  46.     "Invisible: \t" 
  47.     "Polyline flag: \t"  
  48.     "Start width (default): \t"  
  49.     "End width (default): \t" 
  50.     "Curve type: \t"  
  51.     "Definition point: \t"  
  52.     "Start width (0=default): \t"  
  53.     "End width (0=default): \t"  
  54.     "Bulge (0=default): \t"  
  55.     "Vertex flag: \t"   
  56.     "Curve fit tangent direction:\t" 
  57.     "Part name: \t"  
  58.     "Insertion point: \t"  
  59.     "Rotation angle: \t"  
  60.     "X scale factor: \t"  
  61.     "Y scale factor: \t"  
  62.     "Z scale factor: \t"  
  63.     "Attributes follow flag: \t" 
  64.     "Dimension type: \t" 
  65.     "Dim Type Name: \t"    
  66.     "Name: \t" 
  67.     "Definition point: \t" 
  68.     "Center pt. dim text: \t" 
  69.     "Insertion point: \t" 
  70.     "Def. point (13): \t" 
  71.     "Def.point (14): \t" 
  72.     "Def.point (15): \t" 
  73.     "Def.point (16): \t" 
  74.     "Leader length: \t" 
  75.     "Angle of rotated, horiz. or vert. linear dim's: \t" 
  76.     "Horizontal direction: \t" 
  77.     "Extension line angle (oblique dim's): \t" 
  78.     "Rotation angle of dim text: \t" 
  79.     "Text string: \t" 
  80.     "Tag: \t" 
  81.     "Request: \t" 
  82.     "Default value: \t" 
  83.     "Attribute flag: \t" 
  84.     "Attribute value: \t"  
  85.     "Attribute tag: \t" 
  86.     "Attribute flag: \t" 
  87.     "Insertion point: \t" 
  88.     "Rotation angle: \t"  
  89.     "Font: \t"  
  90.     "Text height: \t" 
  91.     "X scale factor: \t" 
  92.     "Oblique angle: \t" 
  93.     "Text generation flag: \t" 
  94.     "Horizontal justification flag: \t" 
  95.     "Vertical alignment flag: \t" 
  96.     "Alignment point: \t" 
  97.   ))
  98.   (if FLX_XLANGUAGE (FLX_XLANGUAGE "_einf" nil))
  99.  
  100.   ;;; --------------------------------------------------------------------------------
  101.   (defun point2s (p_list / p_list retval)
  102.     (setq retval (strcat
  103.        (rtos (nth 0 p_list))
  104.        "," (rtos (nth 1 p_list))
  105.        (if (nth 2 p_list)
  106.          (strcat "," (rtos (nth 2 p_list)))
  107.          ""
  108.        )
  109.     ))
  110.   )
  111.   ;;; --------------------------------------------------------------------------------
  112.   (defun MELIST (l / ret entype tmp1)
  113.   (setq ret (list
  114.        (strcat (nth 0 prt_list) (cdr (assoc 0 l)))  ;;;@"Type:      \t\t"
  115.        (strcat (nth 1 prt_list) (cdr (assoc 8 l)))  ;;;@"Layer:     \t\t" 
  116.        (strcat (nth 2 prt_list)  ;;;@"Line type: \t" 
  117.             (if (setq entype (cdr (assoc 6 l))) entype (nth 3 prt_list))  ;;;@"Layer's line type"
  118.        )
  119.        (strcat (nth 4 prt_list)  ;;;@"Color:     \t\t"
  120.           (cond 
  121.               ((NULL (cdr (assoc 62 l))) (nth 5 prt_list))  ;;;@"Layer's color"
  122.               ((= (cdr (assoc 62 l)) 0) (nth 6 prt_list))   ;;;@"Part definition color"
  123.               ((= (cdr (assoc 62 l)) 256) (nth 7 prt_list)) ;;;@"Layer's color"
  124.               ((symbtos (cdr (assoc 62 l))))
  125.           )
  126.        )
  127.        (strcat (nth 8 prt_list) (symbtos (cdr (assoc 5  l))))  ;;;@"Handle ID:   \t"
  128.   ))
  129.   (setq entype (cdr (assoc 0 l)))
  130.   (cond 
  131.    ((= entype "LINE")  (setq ret (append ret (list
  132.     (strcat (nth  9 prt_list) (point2s (cdr (assoc 10 l))))  ;;;@"Start point: \t" 
  133.     (strcat (nth 10 prt_list) (point2s (cdr (assoc 11 l))))  ;;;@"End point: \t" 
  134.     (strcat (nth 11 prt_list)  ;;;@"Length:    \t"
  135.       (rtos (LENGTH_OF_LINE (cdr (assoc 11 l))(cdr (assoc 10 l))))
  136.     )
  137.    ))))
  138.    ((= entype "CIRCLE") (setq ret (append ret (list
  139.     (strcat (nth 12 prt_list) (point2s (cdr (assoc 10 l))))  ;;;@"Center:       \t"  
  140.     (strcat (nth 13 prt_list) (rtos    (cdr (assoc 40 l))))  ;;;@"Radius:       \t"  
  141.    ))))
  142.    ((= entype "ARC") (setq ret (append ret (list
  143.     (strcat (nth 12 prt_list) (point2s (cdr (assoc 10 l))))  ;;;"Center:       \t"  
  144.     (strcat (nth 13 prt_list) (rtos    (cdr (assoc 40 l))))  ;;;"Radius:       \t"  
  145.     (strcat (nth 14 prt_list) (angtos  (cdr (assoc 50 l))))  ;;;@"Start angle: \t"  
  146.     (strcat (nth 15 prt_list) (angtos  (cdr (assoc 51 l))))  ;;;@"End angle:  \t"  
  147.     (strcat (nth 16 prt_list) (rtos (LENGTH_OF_ARC l)))      ;;;@"Arc length: \t"  
  148.    ))))
  149.    ((= entype "POINT")  (setq ret (append ret (list
  150.     (strcat (nth 17 prt_list) (point2s (cdr (assoc 10 l)))) ;;;@"Coordinates:\t\t" 
  151.    ))))
  152.    ((= entype "SOLID") (setq ret (append ret (list
  153.     (strcat (nth 18 prt_list) (point2s (cdr (assoc 10 l)))) ;;;@"Corner 1: \t"
  154.     (strcat (nth 19 prt_list) (point2s (cdr (assoc 11 l)))) ;;;@"Corner 2: \t"
  155.     (strcat (nth 20 prt_list) (point2s (cdr (assoc 12 l)))) ;;;@"Corner 3: \t"
  156.     (strcat (nth 21 prt_list) (point2s (cdr (assoc 13 l)))) ;;;@"Corner 4: \t"
  157.    ))))
  158.    ((= entype "3DFACE") (setq ret (append ret (list
  159.     (strcat (nth 18 prt_list) (point2s (cdr (assoc 10 l)))) ;;;"Corner 1: \t" 
  160.     (strcat (nth 19 prt_list) (point2s (cdr (assoc 11 l)))) ;;;"Corner 2: \t" 
  161.     (strcat (nth 20 prt_list) (point2s (cdr (assoc 12 l)))) ;;;"Corner 3: \t" 
  162.     (strcat (nth 21 prt_list) (point2s (cdr (assoc 13 l)))) ;;;"Corner 4: \t" 
  163.     (strcat (nth 22 prt_list) (symbtos (cdr (assoc 70 l)))) ;;;@"Invisible: \t" 
  164.    ))))
  165.    ((= entype "POLYLINE")(setq ret (append ret (list
  166.     (strcat (nth 23 prt_list) (symbtos (cdr (assoc 70 l)))) ;;;@"Polyline flag:        \t"  
  167.     (strcat (nth 26 prt_list) (symbtos (cdr (assoc 75 l)))) ;;;@"Curve type:           \t"   
  168.     (strcat (nth 24 prt_list) (rtos (cdr (assoc 40 l))))    ;;;@"Start width (default): \t"  
  169.     (strcat (nth 25 prt_list) (rtos (cdr (assoc 41 l))))    ;;;@"End width (default): \t" 
  170.     ))))
  171.    ((= entype "VERTEX") (setq ret (append ret (list
  172.     (strcat (nth 27 prt_list) (point2s (cdr (assoc 10 l)))) ;;;@"Definition point:              \t"  
  173.     (strcat (nth 28 prt_list) (symbtos (cdr (assoc 40 l)))) ;;;@"Start width (0=default):    \t"  
  174.     (strcat (nth 29 prt_list) (symbtos (cdr (assoc 41 l)))) ;;;@"End width (0=default):     \t"  
  175.     (strcat (nth 30 prt_list) (symbtos (cdr (assoc 42 l)))) ;;;@"Bulge (0=default):             \t"  
  176.     (strcat (nth 31 prt_list) (symbtos (cdr (assoc 70 l)))) ;;;@"Vertex flag:                        \t"   
  177.  ;;;   (strcat (nth 32 prt_list) (symbtos (cdr (assoc 50 l)))) ;;;@"Curve fit tangent direction:\t" 
  178.    ))))
  179.    ((= entype "INSERT") (setq ret (append ret (list
  180.     (strcat (nth 33 prt_list) (cdr (assoc  2 l)))           ;;;@"Part name:         \t"  
  181.     (strcat (nth 34 prt_list) (point2s (cdr (assoc 10 l)))) ;;;@"Insertion point:  \t"  
  182.     (strcat (nth 35 prt_list) (angtos  (cdr (assoc 50 l)))) ;;;@"Rotation angle:  \t"  
  183.     (strcat (nth 36 prt_list) (rtos    (cdr (assoc 41 l)))) ;;;@"X scale factor:   \t"  
  184.     (strcat (nth 37 prt_list) (rtos    (cdr (assoc 42 l)))) ;;;@"Y scale factor:   \t"  
  185.     (strcat (nth 38 prt_list) (rtos    (cdr (assoc 43 l)))) ;;;@"Z scale factor:    \t"  
  186.     (strcat (nth 39 prt_list) (symbtos (cdr (assoc 66 l)))) ;;;@"Attributes follow flag: \t" 
  187.    ))))
  188.    ((= entype "DIMENSION")(setq ret (append ret (list
  189.     (strcat (nth 40 prt_list) (symbtos (cdr (assoc 70 l)))) ;;;@"Dimension type:     \t" 
  190.     (strcat (nth 41 prt_list) (symbtos (cdr (assoc  3 l)))) ;;;@"Dim Type Name:    \t"    
  191.     (strcat (nth 42 prt_list) (symbtos (cdr (assoc  2 l)))) ;;;@"Name:                     \t" 
  192.     (strcat (nth 43 prt_list) (symbtos (cdr (assoc 10 l)))) ;;;@"Definition point:    \t" 
  193.     (strcat (nth 44 prt_list) (symbtos (cdr (assoc 11 l)))) ;;;@"Center pt. dim text: \t" 
  194.     (strcat (nth 45 prt_list) (symbtos (cdr (assoc 12 l)))) ;;;@"Insertion point:       \t" 
  195.     (strcat (nth 46 prt_list) (symbtos (cdr (assoc 13 l)))) ;;;@"Def. point (13):      \t" 
  196.     (strcat (nth 47 prt_list) (symbtos (cdr (assoc 14 l)))) ;;;@"Def.point (14):       \t" 
  197.     (strcat (nth 48 prt_list) (symbtos (cdr (assoc 15 l)))) ;;;@"Def.point (15):       \t" 
  198.     (strcat (nth 49 prt_list) (symbtos (cdr (assoc 16 l)))) ;;;@"Def.point (16):       \t" 
  199.     (strcat (nth 50 prt_list) (symbtos (cdr (assoc 40 l)))) ;;;@"Leader length:        \t" ;;;### ???
  200.     (strcat (nth 51 prt_list) (symbtos (cdr (assoc 50 l)))) ;;;@"Angle of rotated, horiz. or vert. linear dim's: \t" 
  201.     (strcat (nth 52 prt_list) (symbtos (cdr (assoc 51 l)))) ;;;@"Horizontal direction:                          \t" 
  202.     (strcat (nth 53 prt_list) (symbtos (cdr (assoc 52 l)))) ;;;@"Extension line angle (oblique dim's): \t" 
  203.     (strcat (nth 54 prt_list) (symbtos (cdr (assoc 53 l)))) ;;;@"Rotation angle of dim text:                \t" 
  204.    ))))
  205.    ((= entype "TEXT") (setq ret (append ret (list
  206.     (strcat (nth 55 prt_list) (cdr (assoc 1 l))) ;;;@"Text string:       \t" 
  207.    ))))
  208.    ((= entype "ATTDEF") (setq ret (append ret (list
  209.     (strcat (nth 56 prt_list) (cdr (assoc 2 l)))  ;;;@"Tag:                \t" 
  210.     (strcat (nth 57 prt_list) (cdr (assoc 3 l)))  ;;;@"Request:          \t" 
  211.     (strcat (nth 58 prt_list) (cdr (assoc 1 l)))  ;;;@"Default value:  \t" 
  212.     (strcat (nth 59 prt_list) (symbtos (cdr (assoc 70 l)))) ;;;@"Attribute flag:  \t" 
  213.    )))) 
  214.    ((= entype "ATTRIB") (setq ret (append ret (list
  215.     (strcat (nth 60 prt_list) (cdr (assoc 1 l)))  ;;;@"Attribute value: \t"  
  216.     (strcat (nth 61 prt_list) (cdr (assoc 2 l)))  ;;;@"Attribute tag:    \t" 
  217.     (strcat (nth 62 prt_list) (symbtos (cdr (assoc 70 l)))) ;;;@"Attribute flag:   \t" 
  218.    )))) 
  219.   ) ; cond
  220.   (if (or (= entype "TEXT") (= entype "ATTRIB") (= entype "ATTDEF"))
  221.    (setq ret (append ret (list
  222.     (strcat (nth 63 prt_list) (point2s (cdr (assoc 10 l)))) ;;;@"Insertion point:  \t" 
  223.     (strcat (nth 72 prt_list) (point2s (cdr (assoc 11 l)))) ;;;@"Alignment point: \t" 
  224.     (strcat (nth 64 prt_list) (angtos  (cdr (assoc 50 l)))) ;;;@"Rotation angle:  \t"  
  225.     (strcat (nth 65 prt_list) (cdr (assoc 7  l)))           ;;;@"Font:                 \t"  
  226.     (strcat (nth 66 prt_list) (rtos    (cdr (assoc 40 l)))) ;;;@"Text height:      \t" 
  227.     (strcat (nth 67 prt_list) (symbtos (cdr (assoc 41 l)))) ;;;@"X scale factor:   \t" 
  228.     (strcat (nth 68 prt_list) (symbtos (cdr (assoc 51 l)))) ;;;@"Oblique angle:  \t" 
  229.     (strcat (nth 70 prt_list) (symbtos (cdr (assoc 72 l)))) ;;;@"Horizontal justification flag: \t" 
  230.     (strcat (nth 69 prt_list) (symbtos (cdr (assoc 71 l)))) ;;;@"Text generation flag:            \t"  
  231.     (strcat (nth 71 prt_list) (symbtos (cdr (assoc 73 l)))) ;;;@"Vertical alignment flag:       \t" 
  232.   ))))
  233.   (setq ret (append ret (list SEPARATOR)))
  234.   (setq ret ret) 
  235.  )
  236.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  237.  (defun GET_VERTEX(en / ret tmp)
  238.    (setq ret '())
  239.    (while (AND (setq en (entnext en))
  240.                (= (cdr (assoc 0 (entget en))) "VERTEX")
  241.           )
  242.           (setq ret (append ret (list (entget en))))
  243.    ) 
  244.    (setq ret ret)
  245.  )
  246.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  247.  (defun GET_ATTRIB(en / ret tmp)
  248.    (setq ret '())
  249.    (while (AND (setq en (entnext en))
  250.                (= (cdr (assoc 0 (entget en))) "ATTRIB")
  251.           )
  252.           (setq ret (append ret (list (entget en))))
  253.    ) 
  254.    (setq ret ret)
  255.  )
  256.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  257.  (defun LENGTH_of_LINE(a b)
  258.    (sqrt (+ (expt (- (car  a) (car  b)) 2) 
  259.             (expt (- (cadr a) (cadr b)) 2)
  260.             (expt (- (last a) (last b)) 2)
  261.          )
  262.    )
  263.  )
  264.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  265.  (defun LENGTH_of_ARC(el1 / e1 el1 start_ang end_ang radius b_length)
  266.     (setq radius (cdr (assoc 40 el1)))
  267.     (setq start_ang (cdr (assoc 50 el1)))
  268.     (setq end_ang (cdr (assoc 51 el1)))
  269.     (setq b_length (* radius (- end_ang start_ang)))
  270.     (if (< (abs b_length) 0.00000001)
  271.         (setq b_length (abs b_length))
  272.     )
  273.     (if (/= (abs b_length) b_length)
  274.         (setq b_length (+ (* 2.0 pi radius) b_length))
  275.         (setq b_length b_length)
  276.     )
  277.  )
  278.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  279.   (defun DlgInit ()
  280.      (Dlg_ListSetTabstops "ListBox1" "15 18 20")
  281.      (if FLX$WIN95
  282.         (progn
  283.             (foreach n 
  284.                 '("IDCANCEL" "IDOK" "IDHELP" "copyclip" "info" "ListBox1" "selection") 
  285.                 (Dlg_TileSetFont n 2)
  286.             )
  287.             (Dlg_ListSetTabstops "ListBox1" "20 25 30")
  288.          )
  289.         (Dlg_ListSetTabstops "ListBox1" "15 18 20")
  290.      )
  291.      (Dlg_TileAction "copyclip" "(COPYCLIPBOARD)")
  292.      (Dlg_TileAction "IDOK" "(Dlg_DialogDone)")
  293.      (Dlg_TileSet "selection" "")
  294.      (Dlg_TileSet "info" dialog_title) ;;;ENTITY INFORMATION
  295.      (Dlg_ListStart "ListBox1")
  296.      (mapcar 'Dlg_ListAdd lst)
  297.      (Dlg_ListEnd)
  298.   )
  299.   
  300.   (setq SEPARATOR (strcat 
  301.     "--------------------------------------------------------------------------"
  302.     "--------------------------------------------------------------------------"
  303.   ))  
  304.  
  305.   (setq ent_list '())   ;;; empty list
  306.   (setq as (ssget))     ;;; object selection
  307.   (setq i 0)            ;;; 
  308.   (setq flag T)         ;;;
  309.  
  310.   (if as (progn 
  311.      (setq as_length (sslength as))
  312.      (while (and flag (< i as_length))  
  313.        (setq el (entget (ssname as i))) 
  314.        (if el 
  315.          (progn
  316.            (setq ent_list (append ent_list (MELIST el)))
  317.            (if (= (cdr (assoc 0 el)) "POLYLINE")     
  318.               (if (setq tmp (GET_VERTEX (cdr (assoc -1 el))))
  319.                   (foreach el tmp (setq ent_list (append ent_list (MELIST el))))
  320.               )
  321.            )    
  322.            (if (AND (= (cdr (assoc 0  el)) "INSERT")
  323.                     (= (cdr (assoc 66 el)) 1)
  324.                )
  325.               (if (setq tmp (GET_ATTRIB (cdr (assoc -1 el))))
  326.                   (foreach el tmp (setq ent_list (append ent_list (MELIST el))))
  327.               )
  328.            )     
  329.            (if (> (length ent_list) 1000) (progn
  330.                (setq flag nil)
  331.                (setq ent_list (append ent_list 
  332.                    (list
  333.                      ""
  334.                      "********** Text buffer to big!"
  335.                      "********** Entity Information List truncated!"
  336.                    )
  337.                ))
  338.            ))
  339.          ) ; progn
  340.          (setq flag nil) ; else [eigentlich ueberfluessig!]
  341.        ) ; if
  342.        (setq i (+ i 1))
  343.      ) ; while
  344.   ))   ; if as
  345.   (setq lst ent_list)
  346.   (if lst 
  347.      (if (FLX_DLGDSP "flx_dlg" "TABLES" "(princ)" "(DlgInit)") (princ)(exit))
  348.   )  
  349.   (FLX_FUNC_EXIT)
  350.   (princ)
  351. )
  352. ;;; ===========================================================================
  353. (princ)
  354.