;-------------------------------------------------------------------------------
; Program Name: GetVectors.lsp [GetVectors R3]
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
; Date Created: 12-7-01
; Function:     c:GetVectors explodes selected entities into lines segments and
;               writes vector points to C:\Temp\Vectors.lsp which may be viewed
;               by c:ViewVectors.
; Note: There are a few informative notes at the end of this file.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   12-7-01   Initial version
; 2    TM   5-20-04   Added dialogs to assist in creating dialog images.
; 3    TM   3-20-05   Added c:Palet function to view AutoCAD's 255 colors.
;-------------------------------------------------------------------------------
; GetVectors is a programming tool for creating dialog images from AutoCAD
; entities. The entities selected will be exploded into line segments to create
; the image and dialog files C:\Temp\Vectors.lsp and C:\Temp\Vectors.dcl.
; Use the function ViewVectors to view the images created by GetVectors. The
; image and dialog files created by GetVectors may be pasted into your own
; programs and modified as needed.
;-------------------------------------------------------------------------------
; Instructions: Draw a rectangle in units corresponding to the pixel units of
; the image you want to create. For example to create a 100 x 100 pixel image,
; draw a rectangle from 0,0 to 99,-99. Copy and scale the entities you want to
; include in your image into the limits of the outlined rectangle. GetVectors
; creates the blocks GetVectors and DupVectors for reference. Move the blocks
; or the entities off to the side and make modifications as needed.
;-------------------------------------------------------------------------------
; Overview of Main Functions
;-------------------------------------------------------------------------------
; c:GetVectors - Creates an image and dialog file of entities selected.
; c:GV - Shortcut for c:GetVectors
; GetVectors - Function called by c:GetVectors that explodes selected entities
;    into lines segments and writes vector points to C:\Temp\Vectors.lsp.
; WmfExplode - Function called by GetVectors that creates a WMF file of the
;    selection and then explodes the WMF entities into lines.
; c:ViewVectors - View vectors created by c:GetVectors in C:\Temp\Vectors.lsp.
; c:VV - Shortcut for c:ViewVectors
; c:ImageAtts - Image Attributes dialog used to calculate the height and width
;    of dialog images.
; c:IA - Shortcut for c:ImageAtts
; c:Palet - Displays a Palet Image to view AutoCAD's 256 colors.
; c:PI - Shortcut for c:Palet
;-------------------------------------------------------------------------------
; c:GetVectors - Creates an image and dialog file of entities selected.
;-------------------------------------------------------------------------------
(defun c:GV ()(c:GetVectors));Shortcut
(defun c:GetVectors (/ Chk_Value: Dcl_Id% GetVectors@ Help: Info: Q$ Return#
  Var001$ Var002$ Var003$)
  (princ "\nGet Vectors ")(princ)
  ;-----------------------------------------------------------------------------
  ; Chk_Value:
  ;-----------------------------------------------------------------------------
  (defun Chk_Value: (/ Cnt# Mid$ Passed)
    (if (= $key "Toggle003")
      (setq Var003$ $value)
      (progn
        (setq Cnt# 1 Passed t)
        (repeat (strlen $value)
          (setq Mid$ (substr $value Cnt# 1))
          (if (not (member Mid$ (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "0")))
            (setq Passed nil)
          );if
          (setq Cnt# (1+ Cnt#))
        );repeat
        (if (< (atoi $value) 1)
          (setq Passed nil)
        );if
        (if Passed
          (if (= $key "EditInt001")
            (setq Var001$ $value)
            (setq Var002$ $value)
          );progn
          (progn
            (alert "Value entered must be\nan integer greater than 0!")
            (if (= $key "EditInt001")
              (set_tile "EditInt001" Var001$)
              (set_tile "EditInt002" Var002$)
            );progn
          );progn
        );if
      );progn
    );if
  );defun Chk_Value:
  ;-----------------------------------------------------------------------------
  ; Info:
  ;-----------------------------------------------------------------------------
  (defun Info: () (alert (strcat
    "GetVectors is a programming tool for creating dialog images from\n"
    "AutoCAD entities.  The entities selected will be exploded into line\n"
    "segments to create the image and dialog files C:\\Temp\\Vectors.lsp\n"
    "and C:\\Temp\\Vectors.dcl.  Use the function ViewVectors to view\n"
    "the images created by GetVectors.  The image and dialog files\n"
    "created by GetVectors may be pasted into your own programs and\n"
    "modified as needed."))
  );defun Info:
  ;-----------------------------------------------------------------------------
  ; Help:
  ;-----------------------------------------------------------------------------
  (defun Help: () (alert (strcat
    "Draw a rectangle in units corresponding to the pixel units of\n"
    "the image you want to create.  For example to create a 100x100\n"
    "pixel image, draw a rectangle from 0,0 to 99,-99.  Copy and\n"
    "scale the entities you want to include in your image into the\n"
    "limits of the outlined rectangle.  GetVectors creates the blocks\n"
    "GetVectors and DupVectors for reference.  Move the blocks or\n"
    "the entities off to the side and make modifications as needed."))
  );defun Help:
  ;-----------------------------------------------------------------------------
  ; Set variables and load dialog
  ;-----------------------------------------------------------------------------
  (if (not (findfile "C:\\Temp\\Vectors.dat"))
    (progn
      (vl-load-com)(vl-mkdir "C:\\Temp")
      (Info:)
      (Help:)
    );if
  );if
  (if (findfile "C:\\Temp\\Vectors.dat")
    (progn
      (setq FileName% (open "C:\\Temp\\Vectors.dat" "r"))
      (while (setq Text$ (read-line FileName%))
        (setq GetVectors@ (append GetVectors@ (list Text$)))
      );while
      (close FileName%)
    );progn
    (setq GetVectors@ (list "100" "100" "1"))
  );setq
  (setq Var001$ (nth 0 GetVectors@)
        Var002$ (nth 1 GetVectors@)
        Var003$ (nth 2 GetVectors@)
  );setq
  (setq Dcl_Id% (load_dialog "GetVectors.dcl"))
  (new_dialog "GetVectors" Dcl_Id%)
  (GetTiles "GetVectors.dcl" "GetVectors")
  (set_tile "Title" " Get Vectors")
  (set_tile "Text101" " Enter the image size of the")
  (set_tile "Text102" " dialog image to create.")
  (set_tile "Text001" "Width")
  (set_tile "EditInt001" Var001$)
  (set_tile "Text011" "Pixels")
  (set_tile "Text002" "Height")
  (set_tile "EditInt002" Var002$)
  (set_tile "Text022" "Pixels")
  (set_tile "Toggle003" Var003$)
  (action_tile "EditInt001" "(Chk_Value:)")
  (action_tile "EditInt002" "(Chk_Value:)")
  (action_tile "Toggle003"  "(Chk_Value:)")
  (action_tile "Info" "(Info:)")
  (action_tile "Help" "(Help:)")
  (setq Return# (start_dialog))
  (unload_dialog Dcl_Id%)
  (if (= Return# 0) (exit))
  (setq GetVectors@ (list Var001$ Var002$ Var003$))
  (setq FileName% (open "C:\\Temp\\Vectors.dat" "w"))
  (foreach Text$ GetVectors@
    (write-line Text$ FileName%)
  );foreach
  (close FileName%)
  ;-----------------------------------------------------------------------------
  ; Create C:\Temp\Vectors.dcl dialog file
  ;-----------------------------------------------------------------------------
  (setq X-Width$ (rtos (+ (* (1- (atoi Var001$)) (/ 1 6.0)) 0.09) 2 2))
  (setq Y-Height$ (rtos (+ (* (1- (atoi Var002$)) (/ 1 13.0)) 0.048) 2 2))
  (setq Color$ (if (= Var003$ "1") "-2" "-15"))
  (setq Q$ (chr 34))
  (setq FileName% (open "C:\\Temp\\Vectors.dcl" "w"))
  (write-line "dcl_settings : default_dcl_settings { audit_level = 3; }" FileName%)
  (write-line "vectors : dialog {" FileName%)
  (write-line (strcat "  key = "Q$"title"Q$";") FileName%)
  (write-line (strcat "  label = "Q$ Q$";") FileName%)
  (write-line "  spacer;" FileName%)
  (write-line "  : column {" FileName%)
  (write-line "    : image {" FileName%)
  (write-line "      alignment = centered;" FileName%)
  (write-line (strcat "      key = "Q$"vectors"Q$";") FileName%)
  (write-line (strcat "      width = "X-Width$";") FileName%)
  (write-line (strcat "      height = "Y-Height$";") FileName%)
  (write-line "      fixed_width = true;" FileName%)
  (write-line "      fixed_height = true;" FileName%)
  (write-line "      aspect_ratio = 1;" FileName%)
  (write-line (strcat "      color = "Color$";") FileName%)
  (write-line "    }" FileName%)
  (write-line "  }" FileName%)
  (write-line "  : row {" FileName%)
  (write-line "    : column {" FileName%)
  (write-line "      : ok_button {" FileName%)
  (write-line "        alignment = right;" FileName%)
  (write-line "        width = 11;" FileName%)
  (write-line "      }" FileName%)
  (write-line "    }" FileName%)
  (write-line "    : column {" FileName%)
  (write-line "      : cancel_button {" FileName%)
  (write-line "        alignment = left;" FileName%)
  (write-line "        width = 11;" FileName%)
  (write-line "      }" FileName%)
  (write-line "    }" FileName%)
  (write-line "  }" FileName%)
  (write-line "}" FileName%)
  (close FileName%)
  (GetVectors)
  (princ)
);defun c:GetVectors
;-------------------------------------------------------------------------------
; GetVectors - Explodes selected entities into lines segments and writes vector
; points to C:\Temp\Vectors.lsp
;-------------------------------------------------------------------------------
(defun GetVectors (/ Ang~ BlockData@ Center@ Cnt# Clayer Color$ Colors@
  ColorList$ Data$ DataList@ Dist~ Divisions# Duplicates@ EndAngle~ EntColor#
  EntName^ EntLayer$ EntList@ EndPt@ EntType$ FileName% FullAngle~ IncAngle~
  LastEnt^ Len# MajorAxis@ MinorAxis@ NextAngle~ Osmode# Pellipse# PlineWid~
  Pt@ Pt1 Pt2 Pt3 Pt4 Q$ Radius~ StartAngle~ StartPt@ SS& SS_Arc& SS_Block&
  SS_Dups& SS_Erase& SS_Line& SS_Mtext& SS_Solid& SS_Spline& SS_Text& Text$
  X0$ X1$ X1List$ X2$ X2List$ XY-Data$ Y0$ Y1$ Y1List$ Y2$ Y2List$)
  (setvar "CMDECHO" 0)
  (command "UNDO" "BEGIN")
  (setq Clayer (getvar "CLAYER")
        Osmode# (getvar "OSMODE")
        Pellipse# (getvar "PELLIPSE")
        PlineWid~ (getvar "PLINEWID")
  );setq
  (alert (strcat
    "GetVectors explodes the entities selected\n"
    "and creates the blocks GetVectors and\n"
    "DupVectors for reference.  You can enter\n"
    "U to step back through the process."))
  (command "UCS" "WORLD")
  (setq SS_Arc& (ssadd)
        SS_Line& (ssadd)
        SS_Mtext& (ssadd)
        SS_Solid& (ssadd)
        SS_Spline& (ssadd)
        SS_Text& (ssadd)
  );setq
  (if (setq SS& (ssget '((-4 . "<OR") (0 . "ARC") (0 . "CIRCLE")
        (0 . "DIMENSION") (0 . "ELLIPSE") (0 . "LEADER") (0 . "LINE")
        (0 . "LWPOLYLINE") (0 . "MTEXT") (0 . "POLYLINE") (0 . "SOLID")
        (0 . "SPLINE") (0 . "TEXT") (-4 . "OR>")))
      );setq
    (progn
      (command "LAYER" "U" "0" "T" "0" "S" "0" "")
      (setvar "OSMODE" 0)
      (setvar "PELLIPSE" 1)
      (setvar "PLINEWID" 0)
      (setq Cnt# 0)
      (repeat (sslength SS&)
        (setq EntName^ (ssname SS& Cnt#)
              EntList@ (entget EntName^)
              EntType$ (cdr (assoc 0 EntList@))
              EntLayer$ (cdr (assoc 8 EntList@))
        );setq
        (setq EntColor#
          (if (cdr (assoc 62 EntList@))
            (cdr (assoc 62 EntList@))
            (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 EntList@)))))
          );setq
        );setq
        (if (= EntType$ "ELLIPSE")
          (if (/= (cdr (assoc 41 EntList@)) 0)
            (setq EntType$ "SPLINE")
          );if
        );if
        (cond
          ( (= EntType$ "ARC")
            (ssadd EntName^ SS_Arc&)
          );case
          ( (= EntType$ "CIRCLE")
            (setq Center@ (cdr (assoc 10 EntList@))
                  Radius~ (cdr (assoc 40 EntList@))
            );setq
            (command "ARC" "C" Center@
              (polar Center@ (* pi 0.5) Radius~) (polar Center@ (* pi 1.5) Radius~)
            );command
            (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
            (command "CHPROP" (entlast) "" "C" EntColor# "")
            (ssadd (entlast) SS_Arc&)
            (command "ARC" "C" Center@
              (polar Center@ (* pi 1.5) Radius~) (polar Center@ (* pi 0.5) Radius~)
            );command
            (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
            (command "CHPROP" (entlast) "" "C" EntColor# "")
            (ssadd (entlast) SS_Arc&)
            (entdel EntName^)
          );case
          ( (= EntType$ "DIMENSION")
            (setq LastEnt^ (entlast))
            (command "EXPLODE" EntName^)
            (while (setq EntName^ (entnext LastEnt^))
              (setq EntType$ (cdr (assoc 0 (entget EntName^))))
              (command "CHPROP" EntName^ "" "LA" EntLayer$ "")
              (command "CHPROP" EntName^ "" "C" EntColor# "")
              (cond
                ( (= EntType$ "LINE")
                  (ssadd EntName^ SS_Line&)
                );case
                ( (= EntType$ "MTEXT")
                  (ssadd EntName^ SS_Mtext&)
                );case
                ( (= EntType$ "SOLID")
                  (ssadd EntName^ SS_Solid&)
                );case
                ( (= EntType$ "TEXT")
                  (ssadd EntName^ SS_Text&)
                );case
                ( (= EntType$ "POINT")
                  (entdel EntName^)
                );case
              );cond
              (setq LastEnt^ EntName^)
            );while
          );case
          ( (= EntType$ "ELLIPSE")
            (setq Center@ (cdr (assoc 10 EntList@))
                  Dist~ (distance (list 0.0 0.0) (cdr (assoc 11 EntList@)))
                  StartAng~ (angle (list 0.0 0.0) (cdr (assoc 11 EntList@)))
                  MajorAxis@ (polar Center@ StartAng~ Dist~)
                  MinorAxis@ (polar Center@
                    (+ (angle Center@ MajorAxis@) (* pi 0.5))
                    (* Dist~ (cdr (assoc 40 EntList@))))
            );setq
            (command "ELLIPSE" "C" Center@ MajorAxis@ MinorAxis@)
            (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
            (command "CHPROP" (entlast) "" "C" EntColor# "")
            (entdel EntName^)
            (setq LastEnt^ (entlast))
            (command "EXPLODE" LastEnt^)
            (while (setq EntName^ (entnext LastEnt^))
              (setq EntType$ (cdr (assoc 0 (entget EntName^))))
              (if (= EntType$ "ARC")
                (ssadd EntName^ SS_Arc&)
              );if
              (setq LastEnt^ EntName^)
            );while
          );case
          ( (= EntType$ "LEADER")
            (setq LastEnt^ (entlast))
            (command "EXPLODE" EntName^)
            (setq LastEnt^ (entnext LastEnt^))
            (ssadd LastEnt^ SS_Solid&)
            (setq LastEnt^ (entnext LastEnt^))
            (command "EXPLODE" LastEnt^)
            (while (setq EntName^ (entnext LastEnt^))
              (setq EntType$ (cdr (assoc 0 (entget EntName^))))
              (if (= EntType$ "LINE")
                (ssadd EntName^ SS_Line&)
              );if
              (setq LastEnt^ EntName^)
            );while
          );case
          ( (= EntType$ "LINE")
            (ssadd EntName^ SS_Line&)
          );case
          ( (or (= EntType$ "LWPOLYLINE") (= EntType$ "POLYLINE"))
            (setq LastEnt^ (entlast))
            (command "EXPLODE" EntName^)
            (while (setq EntName^ (entnext LastEnt^))
              (setq EntType$ (cdr (assoc 0 (entget EntName^))))
              (cond
                ( (= EntType$ "ARC")
                  (ssadd EntName^ SS_Arc&)
                );case
                ( (= EntType$ "LINE")
                  (ssadd EntName^ SS_Line&)
                );case
              );cond
              (setq LastEnt^ EntName^)
            );while
          );case
          ( (= EntType$ "MTEXT")
            (ssadd EntName^ SS_Mtext&)
          );case
          ( (= EntType$ "SOLID")
            (ssadd EntName^ SS_Solid&)
          );case
          ( (= EntType$ "SPLINE")
            (ssadd EntName^ SS_Spline&)
          );case
          ( (= EntType$ "TEXT")
            (ssadd EntName^ SS_Text&)
          );case
        );cond
        (setq Cnt# (1+ Cnt#))
      );repeat
      ;-------------------------------------------------------------------------
      ; Convert Arcs to Lines
      ;-------------------------------------------------------------------------
      (setq Cnt# 0)
      (repeat (sslength SS_Arc&)
        (setq EntName^ (ssname SS_Arc& Cnt#)
              EntList@ (entget EntName^)
              EntLayer$ (cdr (assoc 8 EntList@))
              Center@ (cdr (assoc 10 EntList@))
              Radius~ (cdr (assoc 40 EntList@))
              StartAngle~ (cdr (assoc 50 EntList@))
              EndAngle~ (cdr (assoc 51 EntList@))
        );setq
        (setq EntColor#
          (if (cdr (assoc 62 EntList@))
            (cdr (assoc 62 EntList@))
            (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 EntList@)))))
          );setq
        );setq
        (if (< EndAngle~ StartAngle~)
          (setq EndAngle~ (+ EndAngle~ (* pi 2)))
        );if
        (setq FullAngle~ (- EndAngle~ StartAngle~))
        (setq IncAngle~ (* (acos (/ (- Radius~ 0.001) Radius~)) 2))
        (if (> IncAngle~ (/ FullAngle~ 3))
          (setq Divisions# 3
                IncAngle~ (/ FullAngle~ Divisions#)
          );setq
          (setq Divisions# (fix (+ (/ FullAngle~ IncAngle~) 0.5))
                IncAngle~ (/ FullAngle~ Divisions#)
          );setq
        );if
        (setq StartPt@ (polar Center@ StartAngle~ Radius~)
              NextAngle~ (+ StartAngle~ IncAngle~)
        );setq
        (repeat Divisions#
          (setq EndPt@ (polar Center@ NextAngle~ Radius~))
          (command "LINE" StartPt@ EndPt@ "")
          (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
          (command "CHPROP" (entlast) "" "C" EntColor# "")
          (ssadd (entlast) SS_Line&)
          (setq StartPt@ EndPt@
                NextAngle~ (+ NextAngle~ IncAngle~)
          );setq
        );repeat
        (entdel EntName^)
        (setq Cnt# (1+ Cnt#))
      );repeat
      ;-------------------------------------------------------------------------
      ; Convert Solids to Lines
      ;-------------------------------------------------------------------------
      (setq Cnt# 0)
      (repeat (sslength SS_Solid&)
        (setq EntName^ (ssname SS_Solid& Cnt#)
              EntList@ (entget EntName^)
              EntLayer$ (cdr (assoc 8 EntList@))
        );setq
        (setq EntColor#
          (if (cdr (assoc 62 EntList@))
            (cdr (assoc 62 EntList@))
            (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 EntList@)))))
          );setq
        );setq
        (command "LINE" (cdr (assoc 10 EntList@)) (cdr (assoc 11 EntList@)) "")
        (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
        (command "CHPROP" (entlast) "" "C" EntColor# "")
        (ssadd (entlast) SS_Line&)
        (command "LINE" (cdr (assoc 11 EntList@)) (cdr (assoc 13 EntList@)) "")
        (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
        (command "CHPROP" (entlast) "" "C" EntColor# "")
        (ssadd (entlast) SS_Line&)
        (if (not (equal (cdr (assoc 13 EntList@)) (cdr (assoc 12 EntList@))))
          (progn
            (command "LINE" (cdr (assoc 13 EntList@)) (cdr (assoc 12 EntList@)) "")
            (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
            (command "CHPROP" (entlast) "" "C" EntColor# "")
            (ssadd (entlast) SS_Line&)
          );progn
        );if
        (command "LINE" (cdr (assoc 12 EntList@)) (cdr (assoc 10 EntList@)) "")
        (command "CHPROP" (entlast) "" "LA" EntLayer$ "")
        (command "CHPROP" (entlast) "" "C" EntColor# "")
        (ssadd (entlast) SS_Line&)
        (entdel EntName^)
        (setq Cnt# (1+ Cnt#))
      );repeat
      ;-------------------------------------------------------------------------
      ; Convert Mtext to Text
      ;-------------------------------------------------------------------------
      (setq Cnt# 0)
      (repeat (sslength SS_Mtext&)
        (setq LastEnt^ (entlast))
        (setq EntName^ (ssname SS_Mtext& Cnt#)
              EntList@ (entget EntName^)
              EntLayer$ (cdr (assoc 8 EntList@))
        );setq
        (setq EntColor#
          (if (cdr (assoc 62 EntList@))
            (cdr (assoc 62 EntList@))
            (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 EntList@)))))
          );setq
        );setq
        (command "EXPLODE" EntName^)
        (while (setq EntName^ (entnext LastEnt^))
          (command "CHPROP" EntName^ "" "LA" EntLayer$ "")
          (command "CHPROP" EntName^ "" "C" EntColor# "")
          (ssadd EntName^ SS_Text&)
          (setq LastEnt^ EntName^)
        );while
        (setq Cnt# (1+ Cnt#))
      );repeat
      ;-------------------------------------------------------------------------
      ; Convert Text to Lines
      ;-------------------------------------------------------------------------
      (if (> (sslength SS_Text&) 0)
        (progn
          (setq LastEnt^ (entlast))
          (WmfExplode SS_Text&)
          (while (setq EntName^ (entnext LastEnt^))
            (setq EntType$ (cdr (assoc 0 (entget EntName^))))
            (if (= EntType$ "LINE")
              (ssadd EntName^ SS_Line&)
            );if
            (setq LastEnt^ EntName^)
          );while
        );progn
      );if
      ;-------------------------------------------------------------------------
      ; Convert Splines to Lines
      ;-------------------------------------------------------------------------
      (if (> (sslength SS_Spline&) 0)
        (progn
          (setq LastEnt^ (entlast))
          (WmfExplode SS_Spline&)
          (while (setq EntName^ (entnext LastEnt^))
            (setq EntType$ (cdr (assoc 0 (entget EntName^))))
            (if (= EntType$ "LINE")
              (ssadd EntName^ SS_Line&)
            );if
            (setq LastEnt^ EntName^)
          );while
        );progn
      );if
      ;-------------------------------------------------------------------------
      ; Create BlockData@ and GetVectors and DupVectors blocks
      ;-------------------------------------------------------------------------
      (setq Cnt# 0 Q$ (chr 34))
      (setq SS_Block& (ssadd))
      (setq SS_Dups& (ssadd))
      (repeat (sslength SS_Line&)
        (setq EntList@ (entget (ssname SS_Line& Cnt#))
              X1$ (itoa (fix (+ 0.51 (abs (cadr  (assoc 10 EntList@))))))
              Y1$ (itoa (fix (+ 0.51 (abs (caddr (assoc 10 EntList@))))))
              X2$ (itoa (fix (+ 0.51 (abs (cadr  (assoc 11 EntList@))))))
              Y2$ (itoa (fix (+ 0.51 (abs (caddr (assoc 11 EntList@))))))
        );setq
        (setq Color$
          (if (cdr (assoc 62 EntList@))
            (itoa (cdr (assoc 62 EntList@)))
            (itoa (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 EntList@))))))
          );setq
        );setq
        (cond
          ((and (= (atoi X1$)(atoi X2$))(> (atoi Y1$)(atoi Y2$)))
            (setq X0$ X1$ X1$ X2$ X2$ X0$ Y0$ Y1$ Y1$ Y2$ Y2$ Y0$)
          );case
          ((> (atoi X1$)(atoi X2$))
            (setq X0$ X1$ X1$ X2$ X2$ X0$ Y0$ Y1$ Y1$ Y2$ Y2$ Y0$)
          );case
        );cond
        (setq Data$ (strcat X1$" "Y1$" "X2$" "Y2$" "Color$))
        (setq XY-Data$ (strcat X1$","Y1$" "X2$","Y2$))
        (if (not (member Data$ BlockData@))
          (progn
            (setq BlockData@ (append BlockData@ (list Data$)))
            (if (and (= X1$ X2$) (= Y1$ Y2$) (>= (atoi (getvar "ACADVER")) 15))
              (princ "\n")
            );if
            (command "LINE" (list (atoi X1$)(atoi Y1$))(list (atoi X2$)(atoi Y2$))"")
            (command "CHPROP" (entlast) "" "C" Color$ "")
            (ssadd (entlast) SS_Block&)
            (setq DataList@ (append DataList@ (list (list X1$ Y1$ X2$ Y2$ Color$))))
            (if (not (member XY-Data$ Duplicates@))
              (setq Duplicates@ (append Duplicates@ (list XY-Data$)))
              (progn
                (princ (strcat "\nDuplicate line created at " XY-Data$ " color " Color$ "."))
                (setq Pt1 (list (atoi X1$)(atoi Y1$))
                      Pt2 (list (atoi X2$)(atoi Y2$))
                      Ang~ (angle Pt1 Pt2)
                      Pt3 (polar Pt1 (+ Ang~ (* pi 0.5)) 0.25)
                      Pt4 (polar Pt2 (+ Ang~ (* pi 0.5)) 0.25)
                      Pt1 (polar Pt3 (angle Pt3 Pt1) 0.5)
                      Pt2 (polar Pt4 (angle Pt4 Pt2) 0.5)
                );setq
                (if (and (= X1$ X2$) (= Y1$ Y2$))
                  (command "CIRCLE" (list (atoi X1$)(atoi Y1$)) 0.25)
                  (command "PLINE" Pt1 Pt2 "A" Pt4 "L" Pt3 "A" Pt1 "CL")
                );if
                (command "CHPROP" (entlast) "" "C" "30" "");or Color$
                (ssadd (entlast) SS_Dups&)
              );progn
            );if
            (if (not (member Color$ Colors@))
              (setq Colors@ (append Colors@ (list Color$)))
            );if
          );progn
          (princ (strcat "\nDuplicate line ignored at " XY-Data$ " color " Color$ "."))
        );if
        (setq Cnt# (1+ Cnt#))
      );repeat
      (if (setq SS_Erase& (ssget "X" '((-4 . "<OR")(2 . "GETVECTORS")(2 . "DUPVECTORS")(-4 . "OR>"))))
        (command "ERASE" SS_Erase& "")
      );if
      (if (tblsearch "BLOCK" "DUPVECTORS")
        (progn
          (command "BLOCK" "DUPVECTORS" "Y" "0,0" SS_Dups& "")
        );progn
        (command "BLOCK" "DUPVECTORS"     "0,0" SS_Dups& "")
      );if
      (command "INSERT" "DUPVECTORS" "0,0" 1 -1 0)
      (if (tblsearch "BLOCK" "GETVECTORS")
        (progn
          (command "BLOCK" "GETVECTORS" "Y" "0,0" SS_Block& "")
        );progn
        (command "BLOCK" "GETVECTORS"     "0,0" SS_Block& "")
      );if
      (command "INSERT" "GETVECTORS" "0,0" 1 -1 0)
      ;-------------------------------------------------------------------------
      ; Process DataList@ and write C:\Temp\Vectors.lsp lisp file
      ;-------------------------------------------------------------------------
      (setq FileName% (open "C:\\Temp\\Vectors.lsp" "w"))
      (write-line "(defun vectors ()" FileName%)
      (write-line (strcat "  (start_image "Q$"vectors"Q$")") FileName%)
      (foreach ColorItem Colors@
        (setq X1List$ "" Y1List$ "" X2List$ "" Y2List$ "" ColorList$ "")
        (foreach Item DataList@
          (if (= (nth 4 Item) ColorItem)
            (progn
              (setq Len# 0)
              (foreach SubItem Item
                (if (> (strlen SubItem) Len#)
                  (setq Len# (strlen SubItem))
                );if
              );foreach
              (setq Len# (1+ Len#))
              (setq X1$ (nth 0 Item)
                    Y1$ (nth 1 Item)
                    X2$ (nth 2 Item)
                    Y2$ (nth 3 Item)
                    Color$ (nth 4 Item)
              );setq
              (while (< (strlen X1$) Len#) (setq X1$ (strcat " " X1$)))
              (while (< (strlen Y1$) Len#) (setq Y1$ (strcat " " Y1$)))
              (while (< (strlen X2$) Len#) (setq X2$ (strcat " " X2$)))
              (while (< (strlen Y2$) Len#) (setq Y2$ (strcat " " Y2$)))
              (while (< (strlen Color$) Len#) (setq Color$ (strcat " " Color$)))
              (setq X1List$ (strcat X1List$ X1$)
                    Y1List$ (strcat Y1List$ Y1$)
                    X2List$ (strcat X2List$ X2$)
                    Y2List$ (strcat Y2List$ Y2$)
                    ColorList$ (strcat ColorList$ Color$)
              );setq
            );progn
          );if
        );foreach
        (write-line (strcat "  (mapcar 'vector_image; Color " ColorItem) FileName%)
        (write-line (strcat "    (list" X1List$ ")") FileName%)
        (write-line (strcat "    (list" Y1List$ ")") FileName%)
        (write-line (strcat "    (list" X2List$ ")") FileName%)
        (write-line (strcat "    (list" Y2List$ ")") FileName%)
        (write-line (strcat "    (list" ColorList$ ")") FileName%)
        (write-line "  );mapcar" FileName%)
      );foreach
      (write-line "  (end_image)" FileName%)
      (write-line ");defun" FileName%)
      (close FileName%)
    );progn
  );if
  (setvar "CLAYER" Clayer)
  (setvar "OSMODE" Osmode#)
  (setvar "PELLIPSE" Pellipse#)
  (setvar "PLINEWID" PlineWid~)
  (command "UCS" "P")
  (command "UNDO" "END")
  (princ)
);defun GetVectors
;-------------------------------------------------------------------------------
; WmfExplode - Explodes WMF entities into lines
; Arguments: 1
;   SS& = Selection set to be exploded
; Returns: Explodes selection into lines
;-------------------------------------------------------------------------------
(defun WmfExplode (SS& / Cnt# EntLast^ EntLayer$ EntName^ LayerName$ Layers@
  Pt1 Pt2 SS_All& SS_Layer& SS_Wmf&)
  (setq Pt1 (polar (getvar "VIEWCTR") (* pi 0.5)(/ (getvar "VIEWSIZE") 2.0))
        Pt2 (polar Pt1 (* pi 1.5) (getvar "VIEWSIZE"))
  );setq
  (command "ZOOM" "E")
  (setq SS_All& (ssget "C" (getvar "EXTMIN") (getvar "EXTMAX")))
  (setq Cnt# 0)
  (repeat (sslength SS&)
    (setq EntName^ (ssname SS& Cnt#))
    (ssdel EntName^ SS_All&)
    (setq Cnt# (1+ Cnt#))
  );repeat
  (if (> (sslength SS_All&) 0)
    (command "ERASE" SS_All& "")
  );if
  (command "ZOOM" "E")
  (command "ZOOM" ".99x")
  (setq Cnt# 0)
  (repeat (sslength SS&)
    (setq LayerName$ (cdr (assoc 8 (entget (ssname SS& Cnt#)))))
    (if (not (member LayerName$ Layers@))
      (setq Layers@ (append Layers@ (list LayerName$)))
    );if
    (setq Cnt# (1+ Cnt#))
  );repeat
  (foreach LayerName$ Layers@
    (setq SS_Layer& (ssadd) Cnt# 0)
    (while (setq EntName^ (ssname SS& Cnt#))
      (setq EntLayer$ (cdr (assoc 8 (entget EntName^))))
      (if (= EntLayer$ LayerName$)
        (ssadd EntName^ SS_Layer&)
      );if
      (setq Cnt# (1+ Cnt#))
    );while
    (setq EntLast^ (entlast))
    (command "WMFOUT" "C:\\Temp\\Temp.wmf" SS_Layer& ""
             "ERASE" SS_Layer& ""
             "WMFIN" "C:\\Temp\\Temp.wmf" (car (ViewExtents)) "2" "" ""
             "EXPLODE" (entlast)
    );command
    (command "CHPROP" (ssget "P") "" "LA" LayerName$ "")
    (command "ERASE" (entnext EntLast^) "")
    (while (setq EntLast^ (entnext EntLast^))
      (if (/= (cdr (assoc 0 (entget EntLast^))) "LINE")
        (command "EXPLODE" EntLast^)
      );if
    );while
  );foreach
  (setq Cnt# 0)
  (repeat (sslength SS_All&)
    (setq EntName^ (ssname SS_All& Cnt#))
    (entdel EntName^)
    (setq Cnt# (1+ Cnt#))
  );repeat
  (command "ZOOM" "W" Pt1 Pt2)
  (princ)
);defun WmfExplode
;-------------------------------------------------------------------------------
; ViewExtents
; Returns: List of upper left and lower right points of current view
;-------------------------------------------------------------------------------
(defun ViewExtents (/ A B C D X)
  (setq B (getvar "VIEWSIZE")
        A (* B (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE"))))
        X (trans (getvar "VIEWCTR") 1 2)
        C (trans (list (- (car X) (/ A 2.0)) (+ (cadr X) (/ B 2.0))) 2 1)
        D (trans (list (+ (car X) (/ A 2.0)) (- (cadr X) (/ B 2.0))) 2 1)
  );setq
  (list C D)
);defun ViewExtents
;-------------------------------------------------------------------------------
; acos
; Arguments: 1
;   X = real number between 0 and 1. May be passed as the sum of dividing two
;       sides of a right triangle.
; Returns: acos of X, the radian degrees between sides of a right triangle
;-------------------------------------------------------------------------------
(defun acos (X)
  (atan (/ (sqrt (- 1 (* X X))) X))
);defun acos
;-------------------------------------------------------------------------------
; c:ViewVectors - View vectors created by c:GetVectors in C:\Temp\Vectors.lsp
;-------------------------------------------------------------------------------
(defun c:VV ()(c:ViewVectors));Shortcut
(defun c:ViewVectors (/ Dcl_Id% X Y)
  (princ "\nView Vectors ")(princ)
  (if (not (new_dialog "vectors" (setq Dcl_Id% (load_dialog "C:\\Temp\\Vectors.dcl"))))
    (exit)
  );if
  (if (findfile "C:\\Temp\\Vectors.lsp")
    (progn
      (load "C:\\Temp\\Vectors.lsp")
      (vectors)
    );progn
  );if
  (set_tile "title" " View Vectors")
  (setq X (dimx_tile "vectors")
        Y (dimy_tile "vectors")
  );setq
  (princ (strcat "\ndimX_tile = " (itoa X) ", dimY_tile = " (itoa Y)))
  (action_tile "OK" "(done_dialog)")
  (start_dialog)
  (unload_dialog Dcl_Id%)
  (princ)
);defun c:ViewVectors
;-------------------------------------------------------------------------------
; c:ImageAtts - Image Attributes
; Calculates the height and width of dialog images based an a 1024 x 768 screen
; area and may vary according to individual screen resolutions.
;-------------------------------------------------------------------------------
(defun c:IA ()(c:ImageAtts));Shortcut
(defun c:ImageAtts (/ Dcl_Id% Return# Var001$ Var002$ Var003$ Var004$ Calc_Values:)
  (princ "\nImage Attributes ")(princ)
  ;-----------------------------------------------------------------------------
  ; Calc_Values:
  ;-----------------------------------------------------------------------------
  (defun Calc_Values: (/ Cnt# Passed Mid$ Int# Real~)
    (setq Cnt# 1 Passed t)
    (cond
      ((or (= $key "EditInt001")(= $key "EditInt002"))
        (repeat (strlen $value)
          (setq Mid$ (substr $value Cnt# 1))
          (if (not (member Mid$ (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "0")))
            (setq Passed nil)
          );if
          (setq Cnt# (1+ Cnt#))
        );repeat
        (if Passed
          (if (= $key "EditInt001")
            (setq Var001$ $value)
            (setq Var002$ $value)
          );progn
          (progn
            (alert "Value entered must be\nan integer greater than 0!")
            (if (= $key "EditInt001")
              (set_tile "EditInt001" Var001$)
              (set_tile "EditInt002" Var002$)
            );progn
          );progn
        );if
      );case
      ((or (= $key "EditReal003")(= $key "EditReal004"))
        (repeat (strlen $value)
          (setq Mid$ (substr $value Cnt# 1))
          (if (not (member Mid$ (list "." "1" "2" "3" "4" "5" "6" "7" "8" "9" "0")))
            (setq Passed nil)
          );if
          (setq Cnt# (1+ Cnt#))
        );repeat
        (if Passed
          (if (= $key "EditReal003")
            (setq Var003$ $value)
            (setq Var004$ $value)
          );progn
          (progn
            (alert "Value entered must be a real\nnumber greater than 0!")
            (if (= $key "EditReal003")
              (set_tile "EditReal003" Var003$)
              (set_tile "EditReal003" Var003$)
            );progn
          );progn
        );if
      );case
    );cond
    (cond
      ((and (= $key "EditInt001")(> (atoi Var001$) 0))
        (setq Int# (atoi Var001$))
        (setq Var003$ (rtos (+ (* (1- Int#)(/ 1 6.0)) 0.09) 2 2))
        (set_tile "EditReal003" Var003$)
      );case
      ((and (= $key "EditInt002")(> (atoi Var002$) 0))
        (setq Int# (atoi Var002$))
        (setq Var004$ (rtos (+ (* (1- Int#)(/ 1 13.0)) 0.048) 2 2))
        (set_tile "EditReal004" Var004$)
      );case
      ((and (= $key "EditReal003")(> (atof Var003$) 0))
        (setq Real~ (atof Var003$))
        (setq Var001$ (itoa (fix (+ 1.5 (/ (- Real~ 0.09) (/ 1 6.0))))))
        (setq Int# (atoi Var001$))
        (setq Var003$ (rtos (+ (* (1- Int#)(/ 1 6.0)) 0.09) 2 2))
        (set_tile "EditInt001" Var001$)
        (set_tile "EditReal003" Var003$)
      );case
      ((and (= $key "EditReal004")(> (atof Var004$) 0))
        (setq Real~ (atof Var004$))
        (setq Var002$ (itoa (fix (+ 1.5 (/ (- Real~ 0.048) (/ 1 13.0))))))
        (setq Int# (atoi Var002$))
        (setq Var004$ (rtos (+ (* (1- Int#)(/ 1 13.0)) 0.048) 2 2))
        (set_tile "EditInt002" Var002$)
        (set_tile "EditReal004" Var004$)
      );case
    );cond
  );defun Calc_Values:
  ;-----------------------------------------------------------------------------
  (if (not *ImageAtts@)
    (setq *ImageAtts@ (list nil "1" "1" "0.09" "0.05"))
  );if
  (setq Var001$ (nth 1 *ImageAtts@)
        Var002$ (nth 2 *ImageAtts@)
        Var003$ (nth 3 *ImageAtts@)
        Var004$ (nth 4 *ImageAtts@)
  );setq
  (setq Dcl_Id% (load_dialog "GetVectors.dcl"))
  (new_dialog "ImageAttributes" Dcl_Id%)
  (set_tile "Title" " Image Attributes")
  (set_tile "Text001" "DimX_tile")
  (set_tile "EditInt001" Var001$)
  (set_tile "Text002" "DimY_tile")
  (set_tile "EditInt002" Var002$)
  (set_tile "Text003" "Width")
  (set_tile "EditReal003" Var003$)
  (set_tile "Text004" "Height")
  (set_tile "EditReal004" Var004$)
  (action_tile "EditInt001"  "(Calc_Values:)")
  (action_tile "EditInt002"  "(Calc_Values:)")
  (action_tile "EditReal003" "(Calc_Values:)")
  (action_tile "EditReal004" "(Calc_Values:)")
  (setq Return# (start_dialog))
  (unload_dialog Dcl_Id%)
  (setq *ImageAtts@ (list nil Var001$ Var002$ Var003$ Var004$))
  (princ)
);defun c:ImageAtts
;-------------------------------------------------------------------------------
; c:Palet - Palet Image
;-------------------------------------------------------------------------------
(defun c:PI ()(c:Palet));Shortcut
(defun c:Palet (/ K C L N X Y Dcl_Id%)
  (setq Dcl_Id% (load_dialog "GetVectors.dcl"))
  (new_dialog "Palet" Dcl_Id%)
  (set_tile "Title" " Palet Image")
  (start_image "Image")
  (setq K 18 L (list 0 8 9 7 255) N 0 Y -3)
  (repeat 5
    (setq C K X 1 Y (+ Y 4))
    (repeat 24
      (fill_image X Y 3 3 C)
      (setq C (+ C 10) X (+ X 4))
    );repeat
    (fill_image X Y 3 3 (nth N L))
    (setq K (- K 2) N (1+ N))
  );repeat
  (setq C 1 X 1 Y (+ Y 4))
  (repeat 6
    (fill_image X Y 15 1 C)
    (setq C (1+ C) X (+ X 16))
  );repeat
  (fill_image X Y 3 1 7)
  (setq K 11 L (list 254 253 252 251 250) N 0 Y 19)
  (repeat 5
    (setq C K X 1 Y (+ Y 4))
    (repeat 24
      (fill_image X Y 3 3 C)
      (setq C (+ C 10) X (+ X 4))
    );repeat
    (fill_image X Y 3 3 (nth N L))
    (setq K (+ K 2) N (1+ N))
  );repeat
  (end_image)
  (start_dialog)
  (unload_dialog Dcl_Id%)
  (princ)
);defun c:Palet
;-------------------------------------------------------------------------------
; widths increment by about ~0.17 per pixel (/ 1 6.0) = 0.166667
; popup_list vs edit_box = 2.5 width diff
; smallest 9.09 = 6.59
;         11.42 = 8.92 same size as Cancel button
; spacer, row, & column
;   0.08 = 1 pixel
;   0.25 = 2 pixels
;   0.42 = 3 pixels
; heights increment by about ~0.08 per pixel (/ 1 13.0) = 0.0769231
; horizontal_margin = none; = no left and right margins
; vertical_margin = none;   = no top and bottom margins
; For heights for list_box
; height = 2.57; = 1 line
; height = 3.80; = 2 lines
; height = 5.03; = 3 lines
; height = 6.26; = 4 lines
; height = 7.49; = 6 lines
; height = 8.73; = 7 lines
; height = 9.96; = 8 lines
; Smallest width for a button
; label = ""; width = 5.58;
; For heights for spacers
; : spacer { height = ?;} don't use fixed_height = true;
;   0.04 = 1 pixel more than spacer;
;   0.12 = 2 pixels ...
;   0.20 = 3 pixels
;   0.27 = 4 pixels
;   0.35 = 5 pixels
;   0.43 = 6 pixels
;   0.50 = 7 pixels
;   0.58 = 8 pixels
;   0.66 = 9 pixels
;   0.73 = 10 pixels
;   0.81 = 11 pixels
;   0.89 = 12 pixels
;   0.96 = 13 pixels
;   1.04 = 14 pixels ... same pattern as above
;-------------------------------------------------------------------------------
(princ);End of GetVectors.lsp