;;; Begin function definitions
;;;
;;; Sub function BLIM

(defun BLIM (BE	   /	 CI    AOBJS OBJS  OBJ	 I     LAY   SP
	     X	   Y	 TP    EP    OLDCE OLDERR      OLDTE CHAR
	     CODE  VS	 EX    TrnOn
	    )
  (GetIni)
  (setq OLDCE (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setvar "plinetype" 0) ; set default plinetype variable
  (setvar "pellipse" 1)  ; set default pellipse variable

;;;==============================================================================================
;;; begin edit
;;; remove version checking for pellipse variable and plinetype variable 
  
;  (setq ACVer (SUBSTR (getvar "AcadVer") 1 2))
;  (if (= ACVer "14")
;    (setvar "plinetype" 0)
;    (setvar "pellipse" 1)
;  )
;  (if (= ACVer "15")
;    (setvar "plinetype" 0)
;    (setvar "pellipse" 1)
;  )

;;; end edit
;;;==============================================================================================

  
  (setq OLDTE (getvar "texteval"))
  (setvar "texteval" 1)
  (setq OLDERR *error*)
  (setq BlimError 0)
  (defun *error* (errmes)
    (princ
      (strcat "\nPart Border not found in drawing\n" ERRMES)
    );princ
    (setq BlimError 1)
    (setvar "cmdecho" OLDCE)
    (setq *error* OLDERR)
    (prin1)
  );defun *error*
  (setq *error* nil)
; NOTE: to turn error handling off, erase the semicolon in the line above. 
; QUERY the drawing and store the resulting selection set in OBJS.  
  (setq Edges 0)
  (setq OBJS (SSGET "X" (QUOTE ((-4 . "<OR") (0 . "LINE") (0 . "POLYLINE") (-4 . "OR>")))))
  (if (> OBJS nil)
     (progn
       (setq XMIN 99999)
       (setq YMIN 99999)
       (setq XMAX -99999)
       (setq YMAX -99999)
       (setq sw 1)
       (GetBorder)
       (setq CX (+ XMIN (/ (- XMAX XMIN) 2)))
       (setq CY (+ YMIN (/ (- YMAX YMIN) 2)))
       (setq XMIN -99999)
       (setq YMIN -99999)
       (setq XMAX 99999)
       (setq YMAX 99999)
       (setq sw 0)
       (GetBorder)
       (if (> CI 7)
 	   (setq Edges 1)
       );if
       (if (> CI 0)
	   (setq Flag 1)
       );if
       (if (< Xmin Xmax)
	 (progn
	   (setq VS "")
	   (setq EX 0)
	   (setq TrnOn 0)
	   (setq I -1)
	   (while (and (setq CHAR (substr LAYR (+ 1 (setq I (1+ I))) 1))(/= CHAR ""))
	     (if (= EX 0)
	       (progn
		 (setq CODE (ascii CHAR))
		 (if (AND (> CODE 47) (< CODE 60))
		   (setq VS (STRCAT VS CHAR))
		   (if (EQUAL CHAR "P")
		     (setq VS (STRCAT VS "."))
		     (if (= TrnOn 1)
		       (setq EX 1)
		     );if
		   );if
		 );if  
		 (if (EQUAL CHAR "Z")
		   (setq TrnOn 1)
		 );if
	       );progn
	     );if
	   );while
	   (setq Thickness (atof VS))
           ;(if(and (< (- XMax XMin) 150) (< (- YMax YMin) 50))
           (if(< Thickness  3))
	     (setq IsInches 1)
	     (setq IsInches 0)
	   );if
	   (setvar "LtScale" (* (- XMax XMin) 0.015))
	 );progn
	 (progn
	   (setq Xmin 0)
	   (setq Xmax 0)
	   (setq Ymin 0)
	   (setq Ymax 0)
	   (setq Thickness 0)
	   (princ "\nERROR * Panel Border NOT FOUND in Drawing *")
	   (setq BlimError 1)
	 );progn
       );if
     );progn
     (progn
       (setq Xmin 0)
       (setq Xmax 0)
       (setq Ymin 0)
       (setq Ymax 0)
       (setq Thickness 0)
       (if (= BE 1)
	 (princ "\nERROR * Panel Border NOT FOUND in Drawing *\n")
       );if
       (setq BlimError 1)
     );progn
  );if
;  (princ "\nX ")
;  (princ XMIN)
;  (princ "  Y ")
;  (princ YMIN)
;  (princ "  X ")
;  (princ XMAX)
;  (princ "  Y ")
;  (princ YMAX)
;  (princ "  Thickness ")
;  (princ Thickness)
;  (princ "  Is Inches ")
;  (princ IsInches)  
  (setvar "cmdecho" OLDCE)
  (setvar "texteval" OLDTE)
  (setq *error* OLDERR)
  (setq a BlimError)
; (prin1)
);defun blim

;;;==============================================================================================
;;; Sub function GetBorder

(defun GetBorder (/ NPL BDR LayHold)	; BEGIN LOOP loop1.
  (setq I -1)
  (setq CI 0)
  (while (setq OBJ (ssname OBJS (setq I (1+ I))))
    (setq LAYR (cdr (assoc 8 (entget OBJ))))
    (setq LAY (SUBSTR Layr 1 6))
    (if	(= Lay "BORDER")
      (progn
	(setq LayHold Layr)
	(setq BDR 1)
	(setq NPL 0)
	(setq TP (cdr (assoc 0 (entget OBJ))))
	(if (= TP "POLYLINE")
	  (progn
	    (setq LC -1)
	    (setq VERT OBJ)
	    (while (/= "SEQEND" (cdr (assoc '0 (entget (setq VERT (entnext VERT))))))
	      (setq LC (1+ LC))
	      (setq CI (1+ CI))
	      (setq SP (cdr (assoc 10 (entget VERT))))
	      (setq X (CAR SP))
	      (setq Y (CADR SP))
	      (if (or (and (<= X XMAX)(> X CX)(<= Y YMAX)(> Y CY)(= sw 0))
		      (and (>= X XMAX) (>= Y YMAX) (= sw 1))
		   );or
		(setq XMAX X YMAX Y)
	      );if
	      (if (or (and (>= X XMIN)(< X CX)(>= Y YMIN)(< Y CY)(= sw 0))
		      (and (<= X XMIN) (<= Y YMIN) (= sw 1))
		  );or
		(setq XMIN X YMIN Y)
	      );if
	    );while					; END LOOP L2.
	  );progn
	  (setq NPL 1)
	);if
	(if (= TP "LWPOLYLINE")
	  (progn
	    (setq LC -1)
	    (setq VERT OBJ)
	    (while (/= "SEQEND" (cdr (assoc '0 (entget (setq VERT (entnext VERT))))))
	      (setq LC (1+ LC))
	      (setq CI (1+ CI))
	      (setq SP (cdr (assoc 10 (entget VERT))))
	      (setq X (CAR SP))
	      (setq Y (CADR SP))
	      (if (or (and (<= X XMAX)(> X CX)(<= Y YMAX)(> Y CY)(= sw 0))
		      (and (>= X XMAX) (>= Y YMAX) (= sw 1))
		  );or
		(setq XMAX X YMAX Y)
	      );if
	      (if (or (and (>= X XMIN)(< X CX)(>= Y YMIN)(< Y CY)(= sw 0))
		      (and (<= X XMIN) (<= Y YMIN) (= sw 1))
		  );or
		(setq XMIN X YMIN Y)
	      );if
	    );while				; END LOOP L2.
	  );progn
	  (setq NPL 1)
	);if
	(if (= TP "LINE")
	  (progn
	    (setq CI (1+ CI))
	    (setq SP (cdr (assoc 10 (entget OBJ))))
	    (setq X (CAR SP))
	    (setq Y (CADR SP))
	    (if (or (and (<= X XMAX) (> X CX) (<= Y YMAX) (> Y CY) (= sw 0))
		    (and (>= X XMAX) (>= Y YMAX) (= sw 1))
	        );or
;		(if (and (<= X XMAX) (> X CX) (<= Y YMAX) (> Y CY))
	       (setq XMAX X YMAX Y)
	    );if
	    (if (or (and (>= X XMIN) (< X CX) (>= Y YMIN) (< Y CY) (= sw 0))
		    (and (<= X XMIN) (<= Y YMIN) (= sw 1))
	        );or
;		(if (and (>= X XMIN) (< X CX) (>= Y YMIN) (< Y CY))
	        (setq XMIN X YMIN Y)
	    );if
	  );progn
	  (setq NPL (+ NPL 1))
	);if
	(if (= NPL 2)
	  (setq	XMIN 0 XMAX 0 YMIN 0 YMAX 0)
	);if
; End THEN section of IF IF2. 
; End IF IF2.
      );progn					; End THEN section of IF IF1. 	
    );if					; End IF IF1. 
  );while
  (if (= BDR nil)
    (setq XMIN 0 XMAX 0 YMIN 0 YMAX 0)
  );if						; END LOOP loop1.
  (setq Layr LayHold)
);defun GetBorder

;;;==============================================================================================
;;;
;;;  Sub function TestOK
;;;

(defun TestOK (/ TempList)
  (setq pname (Get_Tile "Progname"))
  (setq desc (Get_Tile "Descr"))
  (setq len (atof (Get_Tile "Lgth")))
  (setq hght (atof (Get_Tile "Hght")))
  (setq thick (atof (Get_Tile "Thik")))
  (setq Edges (atoi (Get_Tile "Edges")))
  (setq	#BorderGlobalStateList
	 TempList			; Save the dialog's position and pass "1" back to "Status"
	#BorderGlobalDialogPos
	 (done_dialog 1)
  );setq
);defun TestOK


;;;==============================================================================================
;;; Main Border function
;;;

(defun C:Border	(/	     DCLID	 Status	     LocalStateList
		 LocalDialogPos		 OBJS	     OBJ
		 Desc	     Pname	 OLDCLR
		)
  (blim 0)
  (setq	OBJS (SSGET "X" (QUOTE ((-4 . "<AND")(0 . "TEXT")(8 . "DESCRIPTION")(-4 . "AND>")))))
  (if (> OBJS nil)
    (progn				; BEGIN LOOP loop1.
      (setq I -1)
      (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	(setq Desc (cdr (assoc 1 (entget OBJ))))
      );while
    );progn
  );if
  (setq OBJS nil)
  (setq	OBJS (SSGET "X" (QUOTE ((-4 . "<AND") (0 . "TEXT") (8 . "NAME") (-4 . "AND>")))))
  (if (> OBJS nil)
    (progn				; BEGIN LOOP loop1.
      (setq I -1)
      (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	(setq Pname (cdr (assoc 1 (entget OBJ))))
      );while
    );progn
  );if
;  Initialize the local state list to a default setting.
;  Note that the first element of each dotted pair is the key of the
;  associated dialog box tile.
  (setq	LocalStateList '(("Progname" . "")
			 ("Descr" . "")
			 ("Lgth" . "800")
			 ("Hght" . "450")
			 ("Thik" . "19")
			);quote list
					; Initialize the dialog position to a default value
	LocalDialogPos '(-1 -1)
  );setq				; If there's a global state list left over from the last
					;  invocation and we haven't added anything to the local list ...
  (if (and #BorderGlobalStateList
	   (eq (type #BorderGlobalStateList) 'LIST)
	   (= (length #BorderGlobalStateList) (length LocalStateList))
      );and				; Stuff the global state list into the local state list
    (setq LocalStateList #BorderGlobalStateList ; Set up a default dialog box position
	  LocalDialogPos #BorderGlobalDialogPos
    );setq
  );if
; Load the DCL file
  (if (< 0 (setq DCLID (load_dialog "PnlMkr.DCL")))
    (progn				; Initialize the dialog box status to something positive other than 
					; 0 ("Cancel" pressed) or 1 ("OK" pressed)
      (setq Status 32000)		; Until the user presses "Cancel" or "OK" ...
      (while (< 1 Status)		; Fire up the dialog
	(if (new_dialog "Border" DCLID "" LocalDialogPos)
	  (progn			; Initialize / restore the state of the dialog box tiles
	    (foreach Item LocalStateList
	      (set_tile (car Item) (cdr Item))
	    )
	    (setq len  (- XMax XMin)
	    	  hght (- YMax YMin)
	    );setq
	    (if	(> len 0)
	      (set_tile "Lgth" (rtos len 2 3))
	    );if
	    (if	(> hght 0)
	      (set_tile "Hght" (rtos hght 2 3))
	    );if
	    (if	(> Thickness 0)
	      (set_tile "Thik" (rtos Thickness 2 3))
	    );if
	    (if	(> Pname nil)
	      (set_tile "Progname" Pname)
	    );if
	    (if	(> desc nil)
	      (set_tile "Descr" desc)
	    );if
	    (set_tile "Edges" (itoa Edges)) ; Establish callbacks.
	    (action_tile "accept" "(TestOK)")
	    (mode_tile "Progname" 2)	; set focus to the edit box.
					; Do the dialog
	    (setq Status (start_dialog)) ; Now sort out what to do ...
	    (cond
	      ((= Status 0))		; User pressed "Cancel", do nothing
	      ((= Status 1)		; User pressed "OK".  Do whatever.
               (setq os (getvar "osmode"))
	       (setvar "osmode" 0)
	       (setq ce (getvar "cmdecho"))
	       (setvar "cmdecho" 0)
	       (setq OLDClr (getvar "cecolor"))
	       (setvar "cecolor" BorderColor)
	       (setq thkin (fix thick))
	       (setq thkins (itoa thkin))
	       (setq thkfl (- thick thkin))	       
	       (setq thkfls (rtos thkfl 2 3))
	       (setq thkfls (SUBSTR thkfls 3 6))
	       (if (= (substr thkfls 2 2) "00")
	         (setq thkfls (SUBSTR thkfls 1 1))
	       );if
	       (if (= (substr thkfls 3 1) "0")
	         (setq thkfls (SUBSTR thkfls 1 2))
	       );if
	       (setq pt1 (point 0 0))
	       (setq pt2 (point 0 hght))
	       (setq pt3 (point len hght))
	       (setq pt4 (point len 0))	;   (setq desc (strcat "DESCR: " desc))
	       (setq ts (* len 0.71))
	       (setq ts (max ts hght))
	       (setq ts (/ ts 45))
	       (if (> Edges 0)
		 (setq ta (+ thick thick))
		 (setq ta 0)
		 
	       );if
	       (setq th (+ hght ts ts ts ta))
	       (setq tp (point ts th))
	       (setq ts1 (/ ts 1.5))
	       (setq th (+ hght ts ts1 ta))
	       (setq tp1 (point ts th))
	       (setq th (+ th ts ts ts))
	       (setq tp2 (point ts th))
	       (setq PLW (getvar "plinewid"))
	       (setvar "plinewid" 0)
	       (if (> FLAG 0)
		 (progn
		   (command "layer" "Lock" "*" "")
		   (command "layer" "UnLock" "Border*" "")
		   (command "layer" "UnLock" "Description*" "")
		   (command "layer" "UnLock" "Name*" "")
		   (command "erase" "all" "")
		   (command "layer" "UnLock" "*" "")
		   (setq lyrnam "DESCRIPTION")
		   (command "layer" "make" lyrnam "")
		   (command "text" tp ts "" desc)
		   (setq lyrnam "NAME")
		   (command "layer" "make" lyrnam "")
		   (command "text" tp2 ts "" pname)
		   (if (= thkfl 0)
		   	(setq newnam (strcat "BORDER_Z" thkins))
		   	(setq newnam (strcat "BORDER_Z" thkins "P" thkfls))
		   );if
		   (command "layer" "make" newnam "")
		   (command "line" pt1 pt2 pt3 pt4 pt1 "")
		   (command "text" tp1 ts1 "" (strcat (rtos len) " X " (rtos hght) " X " (rtos thick)))
		 );progn
		 (progn
		   (setq lyrnam "DESCRIPTION")
		   (command "layer" "new" lyrnam "make" lyrnam "")
		   (command "text" tp ts "" desc)
		   (setq lyrnam "NAME")
		   (command "layer" "new" lyrnam "make" lyrnam "")
		   (command "text" tp2 ts "" pname)
		   ;(if (> Edges 0)
		   ;  (setq bdrnam "BORDER")
		   ;(if (= thkfl nul)
		   (if (= (strlen thkfls) 0)  
		   	(setq bdrnam (strcat "BORDER_Z" thkins))
		   	(setq bdrnam (strcat "BORDER_Z" thkins "P" thkfls))
		   );if
		   ;(setq bdrnam (strcat "BORDER_Z" thkins "P" thkfls))
					; )
		   (command "layer" "new" bdrnam "make" bdrnam "")
		   (command "line" pt1 pt2 pt3 pt4 pt1 "")
		   (command "text" tp1 ts1 "" (strcat (rtos len) " X " (rtos hght) " X " (rtos thick)))
		   (setq FLAG 1)
		   (setvar "ucsicon" 0)
		 );progn
	       );if
	       (if (> Edges 0)
		 (progn
		   (setq pt1 (point (- 0 thick) 0))
		   (setq pt2 (point (- 0 thick) hght))
		   (setq pt3 (point (- 0 (* 2 thick)) hght))
		   (setq pt4 (point (- 0 (* 2 thick)) 0))
		   (command "line" pt1 pt2 pt3 pt4 pt1 "")
		   (setq pt1 (point 0 (+ hght thick)))
		   (setq pt2 (point len (+ hght thick)))
		   (setq pt3 (point len (+ (* 2 thick) hght)))
		   (setq pt4 (point 0 (+ (* 2 thick) hght)))
		   (command "line" pt1 pt2 pt3 pt4 pt1 "")
		   (setq pt1 (point (+ len thick) 0))
		   (setq pt2 (point (+ len thick) hght))
		   (setq pt3 (point (+ len (* 2 thick)) hght))
		   (setq pt4 (point (+ len (* 2 thick)) 0))
		   (command "line" pt1 pt2 pt3 pt4 pt1 "")
		   (setq pt1 (point 0 (- 0 thick)))
		   (setq pt2 (point len (- 0 thick)))
		   (setq pt3 (point len (- 0 (* 2 thick))))
		   (setq pt4 (point 0 (- 0 (* 2 thick))))
		   (command "line" pt1 pt2 pt3 pt4 pt1 "")
		 );progn
	       );if
	       (command "layer" "make" "0" "")
	       (command "zoom" "_E")
	       (command "zoom" ".95x")
	       (setvar "cmdecho" ce)
	       (setvar "osmode" os)
	       (setvar "plinewid" plw)
	       (setvar "cecolor" OLDClr)
	       (print)
	       (print)
	      ); cond 2
	    );cond
	  );progn
	);if
      );while
    );progn
  );if
  (unload_dialog DCLID)
  (prin1)
);defun C:Border

;;;==============================================================================================
;;;
;;; Sub function point
;;; requires two parameters an X and Y coordinate

(defun point (x y)
  (setq xy (strcat (rtos (+ XMin x)) "," (rtos (+ YMin y))))
);defun point

;;;==============================================================================================
;;;
;;; Sub function SetVBoreDefaults
;;;

(defun SetVBoreDefaults	(/)
  (foreach Item	LocalStateList
    (set_tile (car Item) (cdr Item))
  );foreach
  (if (= VDIST nil)
    (if	(= IsInches 0)
      (set_tile "VDIST" "32")
      (set_tile "VDIST" "1.259")
    );if
  );if
  (princ "Returned to defaults.\n")
  (mode_tile "VX" 2)
);defun SetVBoreDefaults

; Define the function (the program).
;;;==============================================================================================
;;;
;;; Main function C:VBORE
;;;

(defun C:VBORE (/	DCLID	LT	FR	BK	VX	VY
		VZ	VDIA	SVDIA	VNUM	VDIST	VH	VV
		XYZ	L1	L2	LYR	OLDCE	OLDCLR	OLDERR
                OLDTE   LocalStateList  LocalDialogPos  TN      X
                Y       LL      UL      UR      LR      OS      Status
               )
  (Blim 1)
  (if (= BlimError 0)
    (progn
      (if (= IsInches 0)
	(setq LocalStateList '(("Fr" . "1")("Bk" . "")("UL" . "")("UR" . "")("LL" . "1")("LR" . "")("VX" . "")("VY" . "")("VZ" . "")("VDIA" . "1")("SVDIA" . "5")("VNUM" . "1")("VDIST" . "32")("VH" . "1")("VV" . "")("TN" . ""))
	      LocalDialogPos '(-1 -1)
	)
	(setq LocalStateList '(("Fr" . "1")("Bk" . "")("UL" . "")("UR" . "")("LL" . "1")("LR" . "")("VX" . "")("VY" . "")("VZ" . "")("VDIA" . "1")("SVDIA" . "5")("VNUM" . "1")("VDIST" . "1.259")("VH" . "1")("VV" . "")("TN" . ""))
	      LocalDialogPos  '(-1 -1)
	)
      )
      (if (and VBOREGlobalStateList (eq (type VBOREGlobalStateList) 'LIST) (= (length VBOREGlobalStateList) (length LocalStateList)))
	(setq LocalStateList VBOREGlobalStateList LocalDialogPos #VBOREGlobalDialogPos)
      )
      (if (< 0(setq DCLID (load_dialog "PnlMkr.DCL")))
        (if (new_dialog "VBore" DCLID "" LocalDialogPos)
          (progn
            (foreach Item LocalStateList
              (set_tile (car Item) (cdr Item))
            )
            (action_tile "accept" "(TestOKbore \"V\")")
            (action_tile "dflt" "(SetVBoreDefaults)")
            (action_tile "VDIA" "(set_tile \"SVDIA\" (rtos(nth (atoi $value)(list 0.0 5.0 8.0 10.0 12.0 14.0 18.0 25.0 35.0 0.25 0.5))2))")
            (mode_tile "VX" 2)
            (setq status (start_dialog))
	    (if (= status 1)
	      (progn
                (setq OLDCE (getvar "cmdecho"))
                (setvar "cmdecho" 0)
                (setq OLDClr (getvar "cecolor"))
                (setvar "cecolor" VboreColor)
                (setq OLDTE (getvar "texteval"))
                (setvar "texteval" 1)
                (setq LT (getvar "celtype"))
                (setq OLDERR *error*)
                (defun *error* (errmes)
                  (princ (strcat "\nExecution of VBORE halted by the following error: " ERRMES))
                  (setvar "cmdecho" OLDCE)
                  (setq *error* OLDERR)
                  (princ)
                )          
                (if (> BK 0)
                  (command "linetype" "s" "dashed" "")
                  (command "linetype" "s" "continuous" "")
                )
                (setq X (+ XMin VX))
                (setq Y (+ YMin VY))
                (setq VD VDIST)
                (IF (= UL 1)
                  (progn
                    (setq Y (- YMax VY))
                    (if (= VH 0)
                      (setq VD (* VD -1))
                    )
                  )
                )
                (IF (= UR 1)
                  (setq X  (- XMax VX)
                        Y  (- YMax VY)
                        VD (* VD -1)
                  )
                )
                (IF (= LR 1)
                  (progn
                    (setq X (- XMax VX))
                    (if (= VH 1)
                      (setq VD (* VD -1))
                    )
                  )
                )
                (setq XYZ (LIST X Y 0))
                (if (> SVDIA 0) 
                  (setq VDIA svdia)
                  (setq vdia (nth vdia (list 5.0 8.0 10.0 12.0 14.0 18.0 25.0 35.0 0.25 0.5)))
                )
                (setq L1 (FIX VZ))
                (setq L2 (SUBSTR (RTOS (- VZ L1) 2 3) 3 3))
                (setq L1 (ITOA L1))
                (if (= (atoi (SUBSTR L2 2)) 0) 
 		      (setq L2 (SUBSTR L2 1 1))
		    )
		    (if (= (atoi (SUBSTR L2 3)) 0)
		      (setq L2 (SUBSTR L2 1 2))
		    )
                (setq LYR (STRCAT "VBore_Z" L1))
                (if (> (atoi L2) 0)
                  (setq LYR (STRCAT Lyr "P" L2))
                )
                (if (> TN 0)
                  (setq Lyr (STRCAT Lyr "_T" (ITOA TN)))
                )
                (command "layer" "m" LYR "")
                (if (= IsInches 0)
                  (if (< VDIA 1.5)
                    (setq VDIA (* VDIA 25.4))
                  )
                  (if (> VDIA 1.5)
                    (setq VDIA (/ VDIA 25.4))
                  )
                )
                (setq OS (getvar "osmode"))
                (setvar "osmode" 0)
                (command "circle" XYZ "d" VDIA)
                (setvar "osmode" OS)
                (if (> VNUM 1)
                  (if (= VH 0)
                    (command "array" "l" "" "r" VNUM "1" VD)
                    (command "array" "l" "" "r" "1" VNUM VD)
                  )
                )
                (command "linetype" "s" LT "")
                (if (= VZ 0)
                  (princ "*WARNING* Depth is at Zero.")
                )
                (setvar "cmdecho" OLDCE)
                (setvar "cecolor" OLDClr)
                (setvar "texteval" OLDTE)
                (setq *error* OLDERR)
                (princ)
	      )
	    )	
          )
        )
      )
      (unload_dialog DCLID)
      (princ)
    )   
  )  
)
(defun SetHBoreDefaults	(/)
  (foreach Item	LocalStateList
    (set_tile (car Item) (cdr Item))
  )
  (if (= VDIST nil)
    (if	(= IsInches 0)
      (set_tile "VDIST" "32")
      (set_tile "VDIST" "1.259")
    )
  )
  (setq VZ (/ Thickness 2))
  (if (= IsInches 0)
    (set_tile "VZ" (rtos VZ 2 1))
    (set_tile "VZ" (rtos VZ 2 3))
  )
  (princ "Returned to defaults.\n")
  (mode_tile "XY" 2)
)					;BK FR UL UR LL LR XY VZ HD VDia SVDia TN VNUM VDIST VH VV


(defun c:HBORE (/	DCLID	LT	FR	BK	XY	VZ
		HD	VDIA	SVDIA	VNUM	VDIST	VH	VV
		XYZ	L1	L2	LYR	OLDCE	OLDCLR	OLDERR
		OLDTE	Status	LocalStateList	LocalDialogPos	TN
		X	Y	len	hght	pt1	pt2	pt3
		pt4	OS
	       )
  (Blim 1)
  (if (= BlimError 0)
    (progn
      (if (= IsInches 0)
        (setq LocalStateList '(("Fr" . "1")("Bk" . "")("UL" . "")("UR" . "")("LL" . "1")("LR" . "")("XY" . "")("VZ" . "")("HD" . "")("VDIA" . "2")("SVDIA" . "8")("VNUM" . "1")("VDIST" . "32")("VH" . "")("VV" . "1")("TN" . ""))
	      LocalDialogPos '(-1 -1)
	)
	(setq LocalStateList '(("Fr" . "1")("Bk" . "")("UL" . "")("UR" . "")("LL" . "1")("LR" . "")("XY" . "")("VZ" . "")("HD" . "")("VDIA" . "2")("SVDIA" . "8")("VNUM" . "1")("VDIST" . "1.259")("VH" . "")("VV" . "1")("TN" . ""))
	      LocalDialogPos '(-1 -1)
	)
      )
      (if (and HBoreGlobalStateList (eq (type HBoreGlobalStateList) 'LIST)(= (length HBoreGlobalStateList) (length LocalStateList)))
        (setq LocalStateList HBoreGlobalStateList LocalDialogPos #HBoreGlobalDialogPos)
      )
      (if (< 0 (setq DCLID (load_dialog "PnlMkr.DCL")))
	(progn
	  (if (new_dialog "HBore" DCLID "" LocalDialogPos)
	    (progn
	      (foreach	Item LocalStateList
	        (set_tile (car Item) (cdr Item))
	      )
	      (if Thickness
	        (setq VZ (/ Thickness 2))
	      )
	      (if (= IsInches 0)
		(set_tile "VZ" (rtos VZ 2 1))
		(set_tile "VZ" (rtos VZ 2 3))
	      )
	      (action_tile "accept" "(TestOKBore \"H\")")
	      (action_tile "dflt" "(SetHBoreDefaults)")
	      (action_tile "VDIA" "(set_tile \"SVDIA\" (rtos(nth (atoi $value)(list 0.0 5.0 8.0 10.0 12.0 14.0 18.0 25.0 35.0 0.25 0.5))2))")
	      (mode_tile "XY" 2)
	      (setq Status (start_dialog))
	      (if (= status 1)
		(progn
		  (setq OLDCE (getvar "cmdecho"))
		  (setvar "cmdecho" 0)
		  (setq OLDClr (getvar "cecolor"))
		  (setvar "cecolor" HboreColor)
		  (setq OLDTE (getvar "texteval"))
		  (setvar "texteval" 1)
		  (setq LT (getvar "celtype"))
		  (setq OLDERR *error*)
		 ; (defun *error* (errmes)
		 ;   (princ (strcat "\nExecution of HBore halted by the following error: " ERRMES))
		 ;   (setvar "cmdecho" OLDCE)
		 ;   (setq *error* OLDERR)
		 ;   (princ)
		 ; )
		  (if (> BK 0)
		    (command "linetype" "s" "dashed" "")
		    (command "linetype" "s" "continuous" "")
		  )
		  (if (= (+ LL VV) 2)
		    (setq desc "L")
		  )
		  (if (= (+ UL VV) 2)
		    (setq desc "L")
		  )
		  (if (= (+ LR VV) 2)
		    (setq desc "R")
		  )
		  (if (= (+ UR VV) 2)
		    (setq desc "R")
		  )
		  (if (= (+ UL VH) 2)
		    (setq desc "T")
		  )
		  (if (= (+ UR VH) 2)
		    (setq desc "T")
		  )
		  (if (= (+ LL VH) 2)
		    (setq desc "B")
		  )
		  (if (= (+ LR VH) 2)
		    (setq desc "B")
		  )
		  (if (> SVDIA 0)
		    (setq VDIA svdia)
		    (setq vdia	(nth vdia (list 5.0 8.0 10.0 12.0 15.0 18.0 25.0 35.0 0.25 0.5)))
		  )
		  (if (= IsInches 0)
		    (if (< VDIA 1.5)
		      (setq VDIA (* VDIA 25.4))
		    )
		    (if (> VDIA 1.5)
		      (setq VDIA (/ VDIA 25.4))
		    )
		  )
		  (setq len  (- XMax XMin)
		        hght (- YMax YMin)
		        rad  (/ VDIA 2)
		        pos1 (+ XY rad)
		        pos2 (- XY rad)
		        Flag 0
		  )
		  (if (equal desc "L")
		    (setq pt1  (hpoint 0 pos1)
		 	  pt2  (hpoint HD pos1)
			  pt3  (hpoint HD pos2)
			  pt4  (hpoint 0 pos2)
			  Flag 1
		    )
		  )
		  (if (= desc "R")
		    (setq pt1  (hpoint len pos1)
			  pt2  (- len HD)
			  pt2  (hpoint pt2 pos1)
			  pt3  (- len HD)
			  pt3  (hpoint pt3 pos2)
			  pt4  (hpoint len pos2)
			  Flag 1
		    )
		  )
		  (if (= desc "T")
		    (setq pt1  (hpoint pos1 hght)
	 		  pt2  (- hght HD)
			  pt2  (hpoint pos1 pt2)
			  pt3  (- hght HD)
			  pt3  (hpoint pos2 pt3)
			  pt4  (hpoint pos2 hght)
			  Flag 1
		    )
		  )
		  (if (= desc "B")
		    (setq pt1  (hpoint pos1 0)
			  pt2  (hpoint pos1 HD)
			  pt3  (hpoint pos2 HD)
			  pt4  (hpoint pos2 0)
			  Flag 1
		    )
		  )
		  (setq L1 (FIX VZ))
		  (setq L2 (SUBSTR (RTOS (- VZ L1) 2 3) 3 3))
		  (setq L1 (ITOA L1))
              (if (= (atoi (SUBSTR L2 2)) 0)
		   (setq L2 (SUBSTR L2 1 1))
		  )
		  (if (= (atoi (SUBSTR L2 3)) 0)
		   (setq L2 (SUBSTR L2 1 2))
		  )
		  (setq LYR (STRCAT "HBore_Z" L1))
		  (if (> (atoi L2) 0)
		    (setq LYR (STRCAT Lyr "P" L2))
		  )
		  (if (> TN 0)
		    (setq Lyr (STRCAT Lyr "_T" (ITOA TN)))
		  )
		  (command "layer" "m" LYR "")
		  (setq OS (getvar "osmode"))
		  (setvar "osmode" 0)
		  (setq elast (entlast))
		  (command "line" pt1 pt2 pt3 pt4 "")
		  (setq sset nil)
		  (setq sset (ssadd))
		  (while (entnext elast)
		    (setq sset (ssadd (entnext elast) sset))
		    (setq elast (entnext elast))
		  )
		  (setvar "osmode" OS)
		  (command "redraw")
		  (if (> VNUM 1)
		    (progn
		      (if (= VH 0)
	 		(command "array" sset "" "r" VNUM "1" VD)
		 	(command "array" sset "" "r" "1" VNUM VD)
		      )
		    )
		  )
		  (command "linetype" "s" LT "")
		  (if (= VZ 0)
		    (princ "*WARNING* Depth is at Zero.")
		  )
		  (setvar "cmdecho" OLDCE)
		  (setvar "cecolor" OLDClr)
		  (setvar "texteval" OLDTE)
		  (setq *error* OLDERR)
		  (princ)
	        )
	      )
	    )
	  )
	  (unload_dialog DCLID)
        )
      ) 
      (princ)
    )
  )
)  
(defun Hpoint (Vx Vy / x y xy)
  (setq X (+ XMin VX))
  (setq Y (+ YMin VY))
  (setq VD VDIST)
  (IF (= UL 1)
    (progn (if (= VH 0)
	     (progn (setq Y (- YMax VY)) (setq VD (* VD -1)))
	   )
    )
  )
  (IF (= UR 1)
    (progn (setq VD (* VD -1))
	   (if (= VH 1)
	     (setq X (- XMax VX))
	     (setq Y (- YMax VY))
	   )
    )
  )
  (IF (= LR 1)
    (if	(= VH 1)
      (progn (setq VD (* VD -1)) (setq X (- XMax VX)))
    )
  )
  (setq xy (strcat (rtos x) "," (rtos y)))
)

(defun SetGrooveDefaults (/)
  (foreach Item	LocalStateList
    (set_tile (car Item) (cdr Item))
  )
  (princ "Returned to defaults.\n")
  (mode_tile "VY" 2)
)

(defun TestOKGroove (/ TempList)
  (setq BK (atoi (Get_Tile "Bk")))
  (setq FR (atoi (Get_Tile "Fr")))
  (setq UL (atoi (Get_Tile "UL")))
  (setq UR (atoi (Get_Tile "UR")))
  (setq LL (atoi (Get_Tile "LL")))
  (setq LR (atoi (Get_Tile "LR")))
  (setq VX (atof (Get_Tile "VX")))
  (setq VY (atof (Get_Tile "VY")))
  (setq VZ (atof (Get_Tile "VZ")))
  (setq GW (atof (Get_Tile "GW")))
  (setq XY (atof (Get_Tile "XY")))
  (setq EP1 (atoi (Get_Tile "EP1")))
  (setq EP2 (atoi (Get_Tile "EP2")))
  (setq EP3 (atoi (Get_Tile "EP3")))
  (setq TN (atoi (Get_Tile "TN")))
  (setq VH (atoi (Get_Tile "VH")))
  (setq VV (atoi (Get_Tile "VV")))
  (setq	#GrooveGlobalStateList
	 TempList			; Save the dialog's position and pass "1" back to "Status"
	#GrooveGlobalDialogPos
	 (done_dialog 1)
  )
)					; Define the function (the program).

(defun c:Groove	(/	 DCLID	 LT	 FR	 BK	 VX
		 VY	 VZ	 GW	 XY	 EP1	 EP2
		 EP3	 VH	 VV	 XYZ	 EXYZ	 L1
		 L2	 LYR	 OLDCE	 OLDCLR	 OLDERR	 OLDTE
		 Status	 LocalStateList	 LocalDialogPos	 TN
		 X	 Y	 LL	 UL	 UR	 LR
		 OS
		)
  (Blim 1)
  (if
    (= BlimError 0)
     (progn				; Initialize the local state list to a default setting.
					;  Note that the first element of each dotted pair is the key of the
					;  associated dialog box tile.
       (setq LocalStateList
			    '(("Fr" . "1")
			      ("Bk" . "")
			      ("UL" . "")
			      ("UR" . "")
			      ("LL" . "1")
			      ("LR" . "")
			      ("VX" . "0.00")
			      ("VY" . "0.00")
			      ("EP1" . "")
			      ("EP2" . "")
			      ("EP3" . "1")
			      ("VZ" . "0.00")
			      ("GW" . "")
			      ("XY" . "0.00")
			      ("VH" . "1")
			      ("VV" . "")
			     )		; Initialize the dialog position to a default value
	     LocalDialogPos
			    '(-1 -1)
       )				; If there's a global state list left over from the last
					;  invocation and we haven't added anything to the local list ...
       (if
	 (and #GrooveGlobalStateList
	      (eq (type #GrooveGlobalStateList) 'LIST)
	      (= (length #GrooveGlobalStateList) (length LocalStateList))
	 )				; Stuff the global state list into the local state list
	  (setq	LocalStateList
			       #GrooveGlobalStateList
					; Set up a default dialog box position
		LocalDialogPos #GrooveGlobalDialogPos
	  )
       )				; Load the DCL file
       (if
	 (< 0 (setq DCLID (load_dialog "PnlMkr.DCL")))
	  (progn			; Initialize the dialog box status to something positive other than
					; 0 ("Cancel" pressed) or 1 ("OK" pressed)
	    (setq Status 2000)		; Until the user presses "Cancel" or "OK" ...
	    (while (< 1 Status)		; Fire up the dialog
	      (if (new_dialog "Groove" DCLID "" LocalDialogPos)
		(progn			; Initialize / restore the state of the dialog box tiles
		  (foreach Item	LocalStateList
		    (set_tile (car Item) (cdr Item))
		  )
		  (if (> GrooveList nil)
		    (progn
		      (setq VX (car GrooveList))
		      (setq VY (nth 1 GrooveList))
		      (setq VZ (nth 2 GrooveList))
		      (setq LL (nth 3 GrooveList))
		      (setq UL (nth 4 GrooveList))
		      (setq UR (nth 5 GrooveList))
		      (setq LR (nth 6 GrooveList))
		      (setq BK (nth 7 GrooveList))
		      (setq FR (nth 8 GrooveList))
		      (setq TN (nth 9 GrooveList))
		      (setq VH (nth 10 GrooveList))
		      (setq VV (nth 11 GrooveList))
		      (setq GW (nth 12 GrooveList))
		      (setq XY (nth 13 GrooveList))
		      (setq EP1 (nth 14 GrooveList))
		      (setq EP2 (nth 15 GrooveList))
		      (setq EP3 (nth 16 GrooveList))
		    )
		  )
		  (if (> VX nil)
		    (set_tile "VX" (rtos VX 2 3))
		  )
		  (if (> VY nil)
		    (set_tile "VY" (rtos VY 2 3))
		  )
		  (if (> VZ nil)
		    (set_tile "VZ" (rtos VZ 2 3))
		  )
		  (if (> LL nil)
		    (set_tile "LL" (itoa LL))
		  )
		  (if (> UL nil)
		    (set_tile "UL" (itoa UL))
		  )
		  (if (> UR nil)
		    (set_tile "UR" (itoa UR))
		  )
		  (if (> LR nil)
		    (set_tile "LR" (itoa LR))
		  )
		  (if (> BK nil)
		    (set_tile "Bk" (itoa BK))
		  )
		  (if (> FR nil)
		    (set_tile "Fr" (itoa FR))
		  )
		  (if (> TN nil)
		    (if	(> TN 0)
		      (set_tile "TN" (itoa TN))
		    )
		  )
		  (if (> VH nil)
		    (set_tile "VH" (itoa VH))
		  )
		  (if (> VV nil)
		    (set_tile "VV" (itoa VV))
		  )
		  (if (> GW nil)
		    (set_tile "GW" (rtos GW))
		  )
		  (if (> XY nil)
		    (IF	(> XY 0)
		      (set_tile "XY" (rtos XY 2 3))
		    )
		  )
		  (if (> EP1 nil)
		    (set_tile "EP1" (itoa EP1))
		  )
		  (if (> EP2 nil)
		    (set_tile "EP2" (itoa EP2))
		  )
		  (if (> EP3 nil)
		    (set_tile "EP3" (itoa EP3))
		  )			; Establish callbacks.
		  (action_tile "accept" "(TestOKGroove)")
		  (action_tile "dflt" "(SetGrooveDefaults)")
		  (if (= VH 1)
		    (mode_tile "VY" 2)
		    (mode_tile "VX" 2)
		  )			; set focus to the edit box.
					; Do the dialog
		  (setq Status (start_dialog))
					; Now sort out what to do ...
		  (cond
		    ((= Status 0)	; User pressed "Cancel", do nothing
		    )
		    ((= Status 1)	; User pressed "OK".  Do whatever.
		     (setq GrooveList
			    (list VX VY	VZ LL UL UR LR BK FR TN	VH VV GW
				  XY EP1 EP2 EP3)
		     )
					; Save the current value of cmdecho then redefine it.
		     (setq OLDCE (getvar "cmdecho"))
		     (setvar "cmdecho" 0)
		     (setq OLDClr (getvar "cecolor"))
		     (setvar "cecolor" GrooveColor)
					; Save the current value of texteval then set it to 1
		     (setq OLDTE (getvar "texteval"))
		     (setvar "texteval" 1)
					; Save the current value of the error handling subroutine then redefine it.
		     (setq LT (getvar "celtype"))
		     (setq OLDERR *error*)
		     (defun *error* (errmes)
		       (princ
			 (strcat
			   "\nExecution of Groove halted by the following error: "
			   ERRMES
			 )
		       )
		       (setvar "cmdecho" OLDCE)
		       (setq *error* OLDERR)
		       (prin1)
		     )
		     (setq *error* nil)	; NOTE: to turn error handling off, erase the semicolon in the line above. 
					;***************************************************************************   
		     (setq OldPWD (getvar "PlineWid"))
					; IF IF1.  IF bk<>0.
		     (if (> BK 0)	; Begin THEN section of IF IF1. 
		       (progn		; Input to AutoCAD's command line. 
			 (command "linetype" "s" "dashed" "")
		       )		; End IF IF1 THEN. 
					; Begin IF IF1 ELSE. 
		       (progn		; Input to AutoCAD's command line. 
			 (command "linetype" "s" "continuous" "")
		       )		; End ELSE section of IF IF1. 
		     )			; End IF IF1. 
					; OPERATION - store the result in XYZ.
		     (setq X (+ XMin VX))
		     (setq Y (+ YMin VY))
		     (IF (= UL 1)
		       (setq Y (- YMax VY))
		     )
		     (IF (= UR 1)
		       (progn (setq X (- XMax VX)) (setq Y (- YMax VY)))
		     )
		     (IF (= LR 1)
		       (setq X (- XMax VX))
		     )
		     (setq XYZ (LIST X Y 0))
		     (if (= VH 1)
		       (progn		;                        (setq Y (+ YMin VY))
			 (if (or (= UL 1) (= LL 1))
			   (progn
			     (if (= EP1 1)
			       (setq X (- XY XMin))
			     )
			     (if (= EP2 1)
			       (setq X (+ X XY))
			     )
			     (if (= EP3 1)
			       (setq X (- XMax XY))
			     )
			   )
			   (progn
			     (if (= EP1 1)
			       (setq X (- XMax XY))
			     )
			     (if (= EP2 1)
			       (setq X (- X XY))
			     )
			     (if (= EP3 1)
			       (setq X (- XY XMin))
			     )
			   )
			 )
		       )
		       (Progn		;                       (setq X (+ XMin VX))
			 (if (or (= LL 1) (= LR 1))
			   (progn
			     (if (= EP1 1)
			       (setq Y (- XY YMin))
			     )
			     (if (= EP2 1)
			       (setq Y (+ Y XY))
			     )
			     (if (= EP3 1)
			       (setq Y (- YMax XY))
			     )
			   )
			   (progn
			     (if (= EP1 1)
			       (setq Y (- YMax XY))
			     )
			     (if (= EP2 1)
			       (setq Y (- Y XY))
			     )
			     (if (= EP3 1)
			       (setq Y (- XY YMin))
			     )
			   )
			 )
		       )
		     )
		     (setq EXYZ (LIST X Y 0))
					; OPERATION - store the result in L1.  
		     (setq L1 (FIX VZ))	; OPERATION - store the result in L2.  
		     (setq L2 (- VZ L1)); OPERATION - store the result in L2.  
		     (setq L2 (RTOS L2 2 3))
					; OPERATION - store the result in L1.  
		     (setq L1 (ITOA L1)); OPERATION - store the result in L2.  
		     (setq L2 (SUBSTR L2 3 3))
		     (if (= (atoi (SUBSTR L2 2)) 0)
		       (setq L2 (SUBSTR L2 1 1))
		     )
		     (if (= (atoi (SUBSTR L2 3)) 0)
		       (setq L2 (SUBSTR L2 1 2))
		     )
					; OPERATION - store the result in LYR.  
		     (setq LYR (STRCAT "Groove_Z" L1))
		     (if (> (atoi L2) 0)
		       (setq LYR (STRCAT Lyr "P" L2))
		     )
		     (if (> TN 0)
		       (setq Lyr (STRCAT Lyr "_T" (ITOA TN)))
		     )			; Input to AutoCAD's command line. 
		     (command "layer" "m" LYR "")
		     (if (= IsInches 0)
		       (if (< GW 3)
			 (setq GW (* GW 25.4))
		       )
		       (if (> GW 3)
			 (setq GW (/ GW 25.4))
		       )
		     )
					; Input to AutoCAD's command line. 
					;(princ XYZ)
					;(princ EXYZ)
					;(princ GW)
     	    	     (setq OS (getvar "osmode"))
		     (setvar "osmode" 0)
		     (if (> (distance XYZ EXYZ) 0)
		       (command "pline" XYZ "w" GW "" EXYZ "")
		       (princ "*ERROR* Groove is Zero Length.")
		     )
		     (setvar "osmode" OS)
		     (if (= VZ 0)
		       (princ "*WARNING* Depth is at Zero.")
		     )
		     (command "linetype" "s" LT "")
					; Reset "cmdecho" to previous value. 
		     (setvar "cmdecho" OLDCE)
		     (setvar "cecolor" OLDClr)
					; Reset "texteval" to previous value. 
		     (setvar "texteval" OLDTE)
					; Reset *error* to previous definition. 
		     (setvar "PlineWid" OLDPWD)
		     (setq *error* OLDERR)
					; Exit quietly (no return value.)
		     (prin1)
		    )
		  )
		)
	      )
	    )
	  )
       )
       (unload_dialog DCLID)
     )
  )
  (prin1)
)

(defun RListToVars (/)
  (if (> ROUTEList nil)
    (progn
      (setq FR (nth 0 ROUTEList0))
      (setq BK (nth 1 ROUTEList0))
      (setq LRC (nth 2 ROUTEList))
      (setq CRC (nth 3 ROUTEList))
      (setq RRC (nth 4 ROUTEList))
      (setq RAD (nth 5 ROUTEList))
      (setq VZ (nth 6 ROUTEList))
      (setq VDIA (nth 7 ROUTEList))
      (setq TN (nth 8 ROUTEList))
      (setq RPM (nth 9 ROUTEList))
      (setq FV (nth 10 ROUTEList))
      (setq FVC (nth 11 ROUTEList))
      (setq RDV (nth 12 ROUTEList))
      (setq LSL (nth 13 ROUTEList))
      (setq RHI (nth 14 ROUTEList))
      (setq RHO (nth 15 ROUTEList))
      (setq MZA (nth 16 ROUTEList))
      (setq MLT (nth 17 ROUTEList))
      (setq EXC (nth 18 ROUTEList))
      (setq TRPM (nth 19 ROUTEList))
      (setq TFV (nth 20 ROUTEList))
      (setq TFVC (nth 21 ROUTEList))
      (setq TRDV (nth 22 ROUTEList))
      (setq TLSL (nth 23 ROUTEList))
      (setq TRHI (nth 24 ROUTEList))
      (setq TRHO (nth 25 ROUTEList))
      (setq TMZA (nth 26 ROUTEList))
      (setq TMLT (nth 27 ROUTEList))
      (setq TEXC (nth 28 ROUTEList))
    )
  )
)

(defun VarsToTiles (/)
  (if (> FR nil)
    (set_tile "Fr" (itoa FR))
  )
  (if (> BK nil)
    (set_tile "Bk" (itoa BK))
  )
  (if (> VZ nil)
    (set_tile "VZ" (rtos VZ 2 3))
  )
  (if (> LRC nil)
    (set_tile "LRC" (itoa LRC))
  )
  (if (> CRC nil)
    (set_tile "CRC" (itoa CRC))
  )
  (if (> RRC nil)
    (set_tile "RRC" (itoa RRC))
  )
  (if (> RAD nil)
    (set_tile "RAD" (rtos RAD 2 3))
  )
  (if (> VDIA nil)
    (set_tile "VDIA" (rtos VDIA))
  )
  (if (> TN nil)
    (if	(> TN 0)
      (set_tile "TN" (itoa TN))
    )
  )
  (if (> RPM nil)
    (set_tile "RPM" (rtos RPM 2 3))
  )
  (if (> FV nil)
    (set_tile "FV" (rtos FV 2 3))
  )
  (if (> FVC nil)
    (set_tile "FVC" (rtos FVC 2 3))
  )
  (if (> RDV nil)
    (set_tile "RDV" (rtos RDV 2 3))
  )
  (if (> LSL nil)
    (set_tile "LSL" (rtos LSL 2 3))
  )
  (if (> RHI nil)
    (set_tile "RHI" (rtos RHI 2 3))
  )
  (if (> RHO nil)
    (set_tile "RHO" (rtos RHO 2 3))
  )
  (if (> MZA nil)
    (set_tile "MZA" (rtos MZA 2 3))
  )
  (if (> MLT nil)
    (set_tile "MLT" (itoa MLT))
  )
  (if (> EXC nil)
    (set_tile "EXC" (rtos EXC 2 3))
  )
  (if (> TRPM nil)
    (set_tile "TRPM" (itoa TRPM))
  )
  (if (> TFV nil)
    (set_tile "TFV" (itoa TFV))
  )
  (if (> TFVC nil)
    (set_tile "TFVC" (itoa TFVC))
  )
  (if (> TRDV nil)
    (set_tile "TRDV" (itoa TRDV))
  )
  (if (> TLSL nil)
    (set_tile "TLSL" (itoa TLSL))
  )
  (if (> TRHI nil)
    (set_tile "TRHI" (itoa TRHI))
  )
  (if (> TRHO nil)
    (set_tile "TRHO" (itoa TRHO))
  )
  (if (> TMZA nil)
    (set_tile "TMZA" (itoa TMZA))
  )
  (if (> TMLT nil)
    (set_tile "TMLT" (itoa TMLT))
  )
  (if (> TEXC nil)
    (set_tile "TEXC" (itoa TEXC))
  )
)

(defun TilesToVars (/)
  (setq BK (atoi (Get_Tile "Bk")))
  (setq FR (atoi (Get_Tile "Fr")))
  (setq LRC (atoi (Get_Tile "LRC")))
  (setq CRC (atoi (Get_Tile "CRC")))
  (setq RRC (atoi (Get_Tile "RRC")))
  (setq RAD (atof (Get_Tile "RAD")))
  (setq VZ (atof (Get_Tile "VZ")))
  (setq VDia (atof (Get_Tile "VDIA")))
  (setq TN (atoi (Get_Tile "TN")))
  (setq TRPM (atoi (Get_Tile "TRPM")))
  (setq TFV (atoi (Get_Tile "TFV")))
  (setq TFVC (atoi (Get_Tile "TFVC")))
  (setq TRDV (atoi (Get_Tile "TRDV")))
  (setq TLSL (atoi (Get_Tile "TLSL")))
  (setq TRHI (atoi (Get_Tile "TRHI")))
  (setq TRHO (atoi (Get_Tile "TRHO")))
  (setq TMZA (atoi (Get_Tile "TMZA")))
  (setq TMLT (atoi (Get_Tile "TMLT")))
  (setq TEXC (atoi (Get_Tile "TEXC")))
  (setq RPM (atof (Get_Tile "RPM")))
  (setq FV (atof (Get_Tile "FV")))
  (setq FVC (atof (Get_Tile "FVC")))
  (setq RDV (atof (Get_Tile "RDV")))
  (setq LSL (atof (Get_Tile "LSL")))
  (setq RHI (atof (Get_Tile "RHI")))
  (setq RHO (atof (Get_Tile "RHO")))
  (setq MZA (atof (Get_Tile "MZA")))
  (setq MLT (atoi (Get_Tile "MLT")))
  (setq EXC (atof (Get_Tile "EXC")))
)

(defun SetPass (/ Tmp)
  (TilesToVars)
  (setq Pass (atoi (Get_Tile "Pass")))
  (setq	ROUTEList (list	FR    BK    LRC	  CRC	RRC   RAD   VZ	  VDIA
			TN    RPM   FV	  FVC	RDV   LSL   RHI	  RHO
			MZA   MLT   EXC	  TRPM	TFV   TFVC  TRDV  TLSL
			TRHI  TRHO  TMZA  TMLT	TEXC
		       )
  )
  (cond	((= LPass 0) (setq RouteList0 ROUTEList))
	((= LPass 1) (setq RouteList1 ROUTEList))
	((= LPass 2) (setq RouteList2 ROUTEList))
  )
  (cond	((= Pass 0)
	 (mode_tile "Bk" 0)
	 (mode_tile "Fr" 0)
	 (mode_tile "TEXC" 0)
	 (setq RouteList ROUTEList0)
	 (RListToVars)
	 (VarsToTiles)
	)
	((= Pass 1)
	 (mode_tile "Bk" 1)
	 (mode_tile "Fr" 1)
	 (mode_tile "TEXC" 1)
	 (Setq Tmp TEXC)
	 (setq RouteList ROUTEList1)
	 (RListToVars)
	 (Setq TEXC Tmp)
	 (SetRouteDefaults)
	 (VarsToTiles)
	)
	((= Pass 2)
	 (mode_tile "Bk" 1)
	 (mode_tile "Fr" 1)
	 (mode_tile "TEXC" 1)
	 (Setq Tmp TEXC)
	 (setq RouteList ROUTEList2)
	 (RListToVars)
	 (Setq TEXC Tmp)
	 (SetRouteDefaults)
	 (VarsToTiles)
	)
  )
  (cond	((= TEXC 0)
	 (mode_tile "LSL" 0)
	 (mode_tile "TLSL" 0)
	 (mode_tile "RHI" 0)
	 (mode_tile "TRHI" 0)
	 (mode_tile "RHO" 0)
	 (mode_tile "TRHO" 0)
	 (mode_tile "MZA" 0)
	 (mode_tile "TMZA" 0)
	)
	((= TEXC 1)
	 (setq TLSL 0
	       TRHI 0
	       TRHO 0
	       TMZA 0
	 )
	 (VarsToTiles)
	 (mode_tile "LSL" 1)
	 (mode_tile "TLSL" 1)
	 (mode_tile "RHI" 1)
	 (mode_tile "TRHI" 1)
	 (mode_tile "RHO" 1)
	 (mode_tile "TRHO" 1)
	 (mode_tile "MZA" 1)
	 (mode_tile "TMZA" 1)
	)
  )
  (setq LPass Pass)
)

(defun SetRouteDefaults	(/)
  (foreach Item	LocalStateList
    (set_tile (car Item) (cdr Item))
  )
  (mode_tile "VX" 2)
)

(defun ClearAll	(/)
  (SetRouteDefaults)
  (TilesToVars)
  (setq	ROUTEList (list	FR    BK    LRC	  CRC	RRC   RAD   VZ	  VDIA
			TN    RPM   FV	  FVC	RDV   LSL   RHI	  RHO
			MZA   MLT   EXC	  TRPM	TFV   TFVC  TRDV  TLSL
			TRHI  TRHO  TMZA  TMLT	TEXC
		       )
  )
  (setq RouteList0 ROUTEList)
  (setq RouteList1 ROUTEList)
  (setq RouteList2 ROUTEList)
)

(defun Clear (/)
  (SetRouteDefaults)
  (TilesToVars)
  (setq	ROUTEList (list	FR    BK    LRC	  CRC	RRC   RAD   VZ	  VDIA
			TN    RPM   FV	  FVC	RDV   LSL   RHI	  RHO
			MZA   MLT   EXC	  TRPM	TFV   TFVC  TRDV  TLSL
			TRHI  TRHO  TMZA  TMLT	TEXC
		       )
  )
  (cond	((= Pass 0) (setq RouteList0 ROUTEList))
	((= Pass 1) (setq RouteList1 ROUTEList))
	((= Pass 2) (setq RouteList2 ROUTEList))
  )
)

(defun Init (/)
  (SetRouteDefaults)
  (TilesToVars)
  (setq	ROUTEList (list	FR    BK    LRC	  CRC	RRC   RAD   VZ	  VDIA
			TN    RPM   FV	  FVC	RDV   LSL   RHI	  RHO
			MZA   MLT   EXC	  TRPM	TFV   TFVC  TRDV  TLSL
			TRHI  TRHO  TMZA  TMLT	TEXC
		       )
  )
  (if (= RouteList0a nil)
    (setq RouteList0a ROUTEList)
  )
  (if (= RouteList1a nil)
    (setq RouteList1a ROUTEList)
  )
  (if (= RouteList2a nil)
    (setq RouteList2a ROUTEList)
  )
  (setq RouteList0 ROUTEList0a)
  (setq RouteList1 ROUTEList1a)
  (setq RouteList2 ROUTEList2a)
)

(defun TestOKROUTE (/ TempList)
  (SetPass)				;          (TilesToVars)
  (setq	#ROUTEGlobalStateList
	 TempList			; Save the dialog's position and pass "1" back to "Status"
	#ROUTEGlobalDialogPos
	 (done_dialog 1)
  )
)					; Define the function (the program).

(defun c:ROUTE (/	DCLID	LT	FR	BK	VZ	LRC
		CRC	RRC	RAD	VDIA	L1	L2	LYR
		OLDCE	OLDCLR	OLDERR	OLDTE	Status	LocalStateList
		LocalDialogPos	TN	X	Y	RPM	FV
		FVC	RDV	LSL	RHI	RHO	MZA	MLT
		TEXC	TRPM	TFV	TFVC	TRDV	TLSL	TRHI
		TRHO	TMZA	TMLT	TEXC
	       )
  (Blim 1)
  (if (= BlimError 0)
    (progn				; Save the current value of the error handling subroutine then redefine it.
      (setq LT (getvar "celtype"))
      (setq OLDERR *error*)
      (defun *error* (errmes)
	(princ (strcat "\nROUTE halted - " ERRMES " - "))
	(setvar "cmdecho" OLDCE)
	(setq *error* OLDERR)
	(prin1)
      )                 (setq *error* nil)
					; NOTE: to turn error handling off, erase the semicolon in the line above. 
      (setq ss nil)
      (gc)
      (setq ss (ssget))
      (setq pt1 '(0 0))
      (setq LPass 0)
      (if (> ss nil)
	(progn				; Initialize the local state list to a default setting.
					;  Note that the first element of each dotted pair is the key of the
					;  associated dialog box tile.
	  (setq	LocalStateList
			       '(("Fr" . "1")
				 ("Bk" . "")
				 ("VZ" . "")
				 ("LRC" . "")
				 ("CRC" . "1")
				 ("RRC" . "")
				 ("RAD" . "")
				 ("VDIA" . "0")
				 ("TN" . "")
				 ("TRPM" . "")
				 ("RPM" . "")
				 ("TFV" . "")
				 ("FV" . "")
				 ("TFVC" . "")
				 ("FVC" . "")
				 ("TRDV" . "")
				 ("RDV" . "")
				 ("TLSL" . "")
				 ("LSL" . "")
				 ("TRHI" . "")
				 ("RHI" . "")
				 ("TRHO" . "")
				 ("RHO" . "")
				 ("TMZA" . "")
				 ("MZA" . "")
				 ("TMLT" . "")
				 ("MLT" . "")
				 ("TEXC" . "")
				 ("EXC" . "")
				)	; Initialize the dialog position to a default value
		LocalDialogPos
			       '(-1 -1)
	  )				; If there's a global state list left over from the last
					;  invocation and we haven't added anything to the local list ...
	  (if
	    (and
	      #ROUTEGlobalStateList
	      (eq (type #ROUTEGlobalStateList) 'LIST)
	      (= (length #ROUTEGlobalStateList) (length LocalStateList))
	    )				; Stuff the global state list into the local state list
	     (setq LocalStateList
				  #ROUTEGlobalStateList
					; Set up a default dialog box position
		   LocalDialogPos #ROUTEGlobalDialogPos
	     )
	  )				; Load the DCL file
	  (if (< 0 (setq DCLID (load_dialog "PnlMkr.DCL")))
	    (progn			; Initialize the dialog box status to something positive other than
					; 0 ("Cancel" pressed) or 1 ("OK" pressed)
	      (setq Status 2000)	; Until the user presses "Cancel" or "OK" ...
	      (while (< 1 Status)	; Fire up the dialog
		(if (new_dialog "Route" DCLID "" LocalDialogPos)
		  (progn		; Initialize / restore the state of the dialog box tiles
		    (foreach Item LocalStateList
		      (set_tile (car Item) (cdr Item))
		    )
		    (Init)
		    (setq ROUTEList RouteList0)
		    (RListToVars)
		    (VarsToTiles)	; Establish callbacks.
		    (SetPass)
		    (action_tile "accept" "(TestOKROUTE)")
		    (action_tile "dflt" "(Clear)")
		    (action_tile "ClrAll" "(ClearAll)")
		    (action_tile "RDLYR" "(ReadRouteLayVals)")
		    (action_tile "Pass" "(SetPass )")
		    (action_tile "TEXC" "(SetPass )")
		    (mode_tile "VZ" 2)	; set focus to the edit box.
					; Do the dialog
		    (setq Status (start_dialog))
					; Now sort out what to do ...
		    (cond
		      ((= Status 0)	; User pressed "Cancel", do nothing
		      )
		      ((= Status 1)	; User pressed "OK".  Do whatever.
					; Save the current value of cmdecho then redefine it.
		       (setq OLDCE (getvar "cmdecho"))
		       (setvar "cmdecho" 0)
		       (setq OLDClr (getvar "cecolor"))
		       (setvar "cecolor" RouteColor)
		       (setq OLDTE (getvar "texteval"))
		       (setvar "texteval" 1)
					;***************************************************************************                
					; OPERATION - store the result in LYR.
		       (setq RouteList ROUTEList0)
		       (RListToVars)
		       (if (= VZ 0)
			 (princ "*WARNING* Depth is at Zero.")
		       )
		       (if (> TEXC 0)
			 (setq LYR (strcat "EXCAV_Z" (FORMAT VZ)))
			 (setq LYR (strcat "ROUTE_Z" (FORMAT VZ)))
		       )
		       (setq LVZ VZ)
		       (BuildLayer)
		       (if (> BLyr "")
			 (setq LYR (STRCAT LYR BLyr))
		       )
		       (setq RouteList ROUTEList1)
		       (RListToVars)
		       (BuildLayer)
		       (if (> BLyr "")
			 (setq LYR (STRCAT LYR "$" BLyr))
		       )
		       (setq RouteList ROUTEList2)
		       (RListToVars)
		       (BuildLayer)
		       (if (> BLyr "")
			 (setq LYR (STRCAT LYR "$" BLyr))
		       )		; Input to AutoCAD's command line.
		       (if (< (strlen LYR) 32)
			 (command "layer" "m" LYR "")
			 (princ
			   "Too many items for Layer Name - Use Information Block"
			 )
		       )		;***********************************************************************                
		       (cond (ss
			      (setq oldhighlight (getvar "highlight"))
			      (setvar "highlight" 0)
			      (command "change" ss "" "P" "LAYER" Lyr)
			      (command "COLOR" RouteColor)
			      (if (> BK 0)
				(command "LTYPE" "DASHED" "")
				(command "LTYPE" "continuous" "")
			      )
			      (setvar "highlight" oldhighlight)
			     )
		       )		;****************************************************************************                          
		       (setq RouteList0a ROUTEList0)
		       (setq RouteList1a ROUTEList1)
		       (setq RouteList2a ROUTEList2)
					; Reset "cmdecho" to previous value. 
		       (setvar "cmdecho" OLDCE)
		       (setvar "cecolor" OLDClr)
					; Reset "texteval" to previous value. 
		       (setvar "texteval" OLDTE)
					; Reset *error* to previous definition. 
		       (setq *error* OLDERR)
					; Exit quietly (no return value.)
		       (prin1)
		      )
		    )
		  )
		)
	      )
	    )
	  )
	  (unload_dialog DCLID)
	)
      )
    )
  )
  (prin1)
)

(defun Format (V / L1 L2)		; OPERATION - store the result in L1.  
  (setq L1 (FIX V))			; OPERATION - store the result in L2.  
  (setq L2 (- V L1))			; OPERATION - store the result in L2.  
  (setq L2 (RTOS L2 2 3))
  (if (= "." (substr L2 1 1))
    (setq L2 (strcat "0" L2))
  )					;added to replace the "0" that RTOS sometimes loses.
  (setq L1 (ITOA L1))			; OPERATION - store the result in L2.  
  (setq L2 (SUBSTR L2 3 3))
  (if (= (atoi (SUBSTR L2 3)) 0)
    (setq L2 (SUBSTR L2 1 2))
  )
  (if (= (atoi (SUBSTR L2 2)) 0)
    (setq L2 (SUBSTR L2 1 1))
  )
  (if (> (atoi L2) 0)
    (setq L1 (STRCAT L1 "P" L2))
  )
  (setq L1 L1)
)

(defun ReadRouteLayVals	(/ SKV LT Fl1 PLay)
  (setq Fl1 "1")
  (setq OBJ (ssname SS 0))
  (setq LT (cdr (assoc 6 (entget obj))))
  (setq lay (cdr (assoc 8 (entget obj))))
  (setq Lay (keysub "FR" Lay "@"))
  (setq Lay (keysub "FD" Lay "#"))
  (setq Lay (keysub "LD" Lay "*"))
  (setq Lay (keysub "RI" Lay "%"))
  (setq Lay (keysub "RO" Lay "^"))
  (setq Lay (keysub "OZ" Lay "&"))
  (setq PLay " ")
  (setq I 5)
  (setq CT 0)
  (setq frst (substr Lay 1 6))
  (setq Lay (STRCAT Lay "$"))
  (while (and (setq CHAR (substr LAY (+ 1 (setq I (1+ I))) 1))
	      (/= CHAR "")
	 )
    (if	(= "$" CHAR)
      (progn
	(SetRouteDefaults)
	(ReadToTiles)
	(setq LPass CT)
	(set_tile "Pass" (itoa CT))
	(SetPass)
	(setq CT (+ CT 1))
	(setq PLay " ")
      )
      (setq PLay (STRCAT PLay CHAR))
    )
  )
  (if (= LT "DASHED")
    (progn (set_tile "Fr" "0") (set_tile "Bk" "1"))
    (progn (set_tile "Fr" "1") (set_tile "Bk" "0"))
  )
  (set_tile "Pass" "0")
  (SetPass)
)

(defun ReadToTiles (/)
  (set_tile "TN" (KeyVal "T" PLay))
  (setq SKV (KeyVal "R" PLay))
  (if (> SKV "")
    (progn (set_tile "RAD" SKV)
	   (set_tile "RRC" "1")
	   (setq fl1 "0")
    )
  )
  (setq SKV (KeyVal "L" PLay))
  (if (> SKV "")
    (progn (set_tile "RAD" SKV)
	   (set_tile "LRC" "1")
	   (setq fl1 "0")
    )
  )
  (set_tile "CRC" Fl1)
  (setq SKV (KeyVal "Z" PLay))
  (if (> SKV "")
    (set_tile "VZ" SKV)
  )
  (setq SKV (KeyVal "D" PLay))
  (if (> SKV "")
    (set_tile "VDIA" SKV)
  )
  (setq SKV (KeyVal "S" PLay))
  (if (> SKV "")
    (progn (set_tile "RPM" SKV) (set_tile "TRPM" "1"))
  )
  (setq SKV (KeyVal "F" PLay))
  (if (> SKV "")
    (progn (set_tile "FV" SKV) (set_tile "TFV" "1"))
  )
  (setq SKV (KeyVal "@" PLay))
  (if (> SKV "")
    (progn (set_tile "FVC" SKV) (set_tile "TFVC" "1"))
  )
  (setq SKV (KeyVal "#" PLay))
  (if (> SKV "")
    (progn (set_tile "RDV" SKV) (set_tile "TRDV" "1"))
  )
  (setq SKV (KeyVal "*" PLay))
  (if (> SKV "")
    (progn (set_tile "LSL" SKV) (set_tile "TLSL" "1"))
  )
  (setq SKV (KeyVal "%" PLay))
  (if (> SKV "")
    (progn (set_tile "RHI" SKV) (set_tile "TRHI" "1"))
  )
  (setq SKV (KeyVal "^" PLay))
  (if (> SKV "")
    (progn (set_tile "RHO" SKV) (set_tile "TRHO" "1"))
  )
  (setq SKV (KeyVal "&" PLay))
  (if (> SKV "")
    (progn (set_tile "MZA" SKV) (set_tile "TMZA" "1"))
  )
  (setq SKV (KeyVal "M" PLay))
  (if (> SKV "")
    (progn (set_tile "MLT" SKV) (set_tile "TMLT" "1"))
  )
  (setq SKV (KeyVal "K" PLay))
  (if (> SKV "")
    (progn (set_tile "EXC" SKV) (set_tile "TEXC" "1"))
  )

)

(defun KeyVal (KL lay / VS EX I CODE CHAR NCODE NCHAR Trnon V)
  (setq VS "")
  (setq EX 0)
  (setq TrnOn 0)
  (setq I 0)
  (while (and (setq CHAR (substr LAY (+ 1 (setq I (1+ I))) 1))
	      (/= CHAR "")
	 )
    (setq NCHAR (substr LAY (+ 2 I) 1))
    (setq NCODE (ascii NCHAR))
    (if	(= EX 0)
      (progn
	(setq CODE (ascii CHAR))
	(if (AND (> CODE 47) (< CODE 60))
	  (progn (setq VS (STRCAT VS CHAR)))
	  (progn (if (EQUAL CHAR "P")
		   (progn (setq VS (STRCAT VS ".")))
		   (progn (if (= TrnOn 1)
			    (setq EX 1)
			  )
		   )
		 )
	  )
	)
	(if (AND (> NCODE 47) (< NCODE 60) (EQUAL CHAR KL))
	  (progn (setq TrnOn 1) (setq VS ""))
	  (if (= Char KL)
	    (progn (setq VS " ") (setq EX 1))
	  )
	)
      )
    )
  )
  (if (and (= TrnOn 0) (/= VS " "))
    (setq VS "")
  )
  (setq VS VS)
)

(defun KeySub (KL lay SB / VS I CHAR frst)
  (setq VS "")
  (setq I 5)
  (setq frst (substr Lay 1 6))
  (while (and (setq CHAR (substr LAY (+ 1 (setq I (1+ I))) 2))
	      (/= CHAR "")
	 )
    (if	(= KL CHAR)
      (progn (setq VS (STRCAT VS SB)) (setq I (+ I 1)))
      (setq VS (STRCAT VS (substr CHAR 1 1)))
    )
  )
  (setq VS (strcat frst VS))
)

(defun BuildLayer (/)
  (setq BLyr "")
  (if (= IsInches 0)
    (if	(< VDIA 1.5)
      (setq VDIA (* VDIA 25.4))
    )
    (if	(> VDIA 1.5)
      (setq VDIA (/ VDIA 25.4))
    )
  )
  (if (and (/= VZ LVZ) (/= VZ 0))
    (setq BLyr (STRCAT BLyr "Z" (FORMAT VZ)))
  )
  (setq LVZ VZ)
  (if (and (/= TN 0) (/= TN LTN))
    (setq BLyr (STRCAT BLyr "T" (format TN)))
    (if	(> VDia 0)
      (setq BLyr (STRCAT BLyr "D" (format VDia)))
    )
  )
  (setq LTN TN)
  (if (> LRC 0)
    (if	(> RAD 0)
      (setq BLyr (STRCAT BLyr "L" (format RAD)))
      (setq BLyr (STRCAT BLyr "L"))
    )
  )
  (if (> RRC 0)
    (if	(> RAD 0)
      (setq BLyr (STRCAT BLyr "R" (format RAD)))
      (setq BLyr (STRCAT BLyr "R"))
    )
  )
  (if (and (> TRPM 0) (> RPM 0))
    (setq BLyr (STRCAT BLyr "S" (format RPM)))
  )
  (if (and (> TFV 0) (> FV 0))
    (setq BLyr (STRCAT BLyr "F" (format FV)))
  )
  (if (and (> TFVC 0) (> FVC 0))
    (setq BLyr (STRCAT BLyr "FR" (format FVC)))
  )
  (if (and (> TRDV 0) (> RDV 0))
    (setq BLyr (STRCAT BLyr "FD" (format RDV)))
  )
  (if (> TLSL 0)
    (progn
      (if (> LSL 0)
	(setq BLyr (STRCAT BLyr "LD" (format LSL)))
	(setq BLyr (STRCAT BLyr "LD"))
      )
      (if (> TRHI 0)
	(if (> RHI 0)
	  (setq BLyr (STRCAT BLyr "RI" (format RHI)))
	  (setq BLyr (STRCAT BLyr "RI"))
	)
      )
      (if (> TRHO 0)
	(if (> RHO 0)
	  (setq BLyr (STRCAT BLyr "RO" (format RHO)))
	  (setq BLyr (STRCAT BLyr "RO"))
	)
      )
    )
  )
  (if (> TMZA 0)
    (if	(> MZA 0)
      (setq BLyr (STRCAT BLyr "OZ" (format MZA)))
      (setq BLyr (STRCAT BLyr "OZ"))
    )
  )
  (if (and (> TMLT 0) (> MLT 0))
    (setq BLyr (STRCAT BLyr "M" (format MLT)))
  )
  (if (and (> TEXC 0) (> EXC 0))
    (setq BLyr (STRCAT BLyr "K" (format EXC)))
  )
)

(defun c:spda (/ ss OLDClr OS CE pt1 pt2 pt3 d1 d2 lw LT ELT Sel Hd PLW en ed)
  (setq ss nil)
  (Blim 0)
  (gc)
  (setq os (getvar "osmode"))
  (setq ce (getvar "cmdecho"))
  (setq LT (getvar "celtype"))
  (setq PLW (getvar "plinewid"))
  (setvar "cmdecho" 0)
  (setq OLDClr (getvar "cecolor"))
  (setvar "cecolor" RouteColor)
  (setq OLDERR *error*) 
  (defun *error* (errmes)
    (princ (strcat "\nSPDA halted - " ERRMES " - "))
    (setvar "cmdecho" OLDCE)
    (setq *error* OLDERR)
    (prin1)
  )                 (setq *error* nil)
					; NOTE: to turn error handling off, erase the semicolon in the line above. 
  (setq ss nil)
  (gc)
  (setq ss (entsel " Select start point of route\n\r"))
  (if (> ss nil)
      (progn
          (setq hd (entget (car ss)))
          (setq pt1 (nth 1 ss))
          (if (and (or
                  (= (dxf 0 hd) "LWPOLYLINE")
                  (= (dxf 0 hd) "POLYLINE")
                )
              (= (dxf 70 hd) 1)
              )
              (progn
                (setq Sel (strcase (getstring "\r This is a closed Polyline. Do you wish to Explode it? (Y/N) <N>: ")))            
                (if (= sel "Y")
                    (progn
                        (Command "explode" ss)
                        (setq ss (nentselp pt1))
                    )
                    (progn
                        (if (= (dxf 0 hd) "POLYLINE")
                          (progn
                            (setq en (dxf -1 hd))
                            (setq en (entnext en))
                            (setq ed (entget en))
                            (setq pt1 (dxf 10 ed))
                           ))
                        (if (= (dxf 0 hd) "LWPOLYLINE")
                            (setq pt1 (dxf 10 hd))
                        )
                    )
                )
              )
          )
          (if (and                   
                  (= (dxf 0 hd) "POLYLINE")
                  (= (dxf 70 hd) 0)
              )
              (progn
                (setq d2 0)
                (setq pt1 (osnap pt1 "end,qua"))
                (setq en (dxf -1 hd))
                (setq en (entnext en))
                (setq ed (entget en))
                (setq pt2 (dxf 10 ed))
                (While ( and ( setq en (entnext en))
                            (setq ed (entget en))
                            (/= "SEQEND" (dxf 0 ed))
                        )
                        (setq pt3 (dxf 10 ed))
                        (setq d2 (+ d2 (distance pt2 pt3)))
                        (if (= 0 (distance pt1 pt3)) (progn (setq d1 d2) (setq d2 0) ))
                )
                (if (> d1 d2) (setq pt1 pt3) (setq pt1 pt2) )
              )
          )
          (if (= (dxf 0 (setq hd (entget (car ss)))) "LINE")
              (progn
                  (setq Sel (strcase (getstring "\r  [N]ear, [M]id, [E]nd  <E>: ")))            
                  (if (= sel "N") (command "break" pt1 "@"))
                  (if (= sel "M")
                     (progn
                        (setq pt1 (osnap pt1 "mid,qua"))
                        (command "break" pt1 "@")
                     )
                  )
              )
          )
          
        (setq pt1 (osnap pt1 "end,qua"))
        (setq lay (cdr (assoc 8 (entget (car ss)))))
        (setq ELT (cdr (assoc 6 (entget (car ss)))))
    ;   (if (= (substr lay 1 5) "ROUTE")
    ;       (progn
              (command "layer" "set" lay "")
              (setvar "osmode" 0)
              (setq pt2 (getpoint " Select point for back of arrow\n\r" PT1))
              (if (and (> pt1 nil) (> pt2 nil))
              (progn
                (if (> ELT nil) (command "linetype" "s" ELT ""))
                (setq lw (distance pt1 pt2))
                (setq lw (/ lw 3))
                (command "pline" pt1 "w" "0" lw pt2 "")
              )
              (princ " * Endpoint not selected *\n")
              )
              (command "linetype" "s" LT "")
              (setvar "osmode" os)
              (setvar "cmdecho" ce)
              (setvar "cecolor" OLDClr)
              (setvar "plinewid" PLW)
              
              (print)
              (print)
              (princ)
;	    )
;	    (princ " * Line is not on a ROUTE layer *\n")
;	)
      )
      (princ " * Nothing selected *\n")
  )
  (Prin1)
)

(defun c:layset	()
  (storevars)
  (setq *error* adserror)
  (setvar "cmdecho" 0)
  (setvar "aperture" 4)
  (setvar "osmode" 256)
  (princ
    "\nPick an entity that is on the layer you wish to change to..."
  )
  (setq entity (entget (car (entsel))))
  (setq lyr (cdr (assoc 8 entity)))
  (command "layer" "s" lyr "")
  (setq clayer lyr)
  (princ "\nCurrent layer has been set to ")
  (princ lyr)
  (setq	entity nil
	lyr nil
  )
  (resetvars)
  (princ)
)

(princ)					;******************************************************************* 

(defun adserror	(msg)
  (princ "\nError: ")
  (princ msg)
  (resetvars)
  (princ)
)

(defun storevars ()
  (setq oldaperture (getvar "aperture"))
  (setq oldclayer (getvar "clayer"))
  (setq olderror *error*)
  (setq oldcmdecho (getvar "cmdecho"))
  (setq oldsnapmode (getvar "snapmode"))
  (setq oldosmode (getvar "osmode"))
  (setq oldorthomode (getvar "orthomode"))
  (setq oldblipmode (getvar "blipmode"))
  (setq oldhighlight (getvar "highlight"))
  (setq oldangbase (getvar "angbase"))
)

(defun resetvars ()
  (command "layer" "s" curlayer "")
  (setvar "cmdecho" oldcmdecho)
  (setvar "snapmode" oldsnapmode)
  (setvar "osmode" oldosmode)
  (setvar "orthomode" oldorthomode)
  (setvar "blipmode" oldblipmode)
  (setvar "highlight" oldhighlight)
  (setvar "angbase" oldangbase)
  (setvar "aperture" oldaperture)
  (setq *error* olderror)
)

(defun c:match ()
  (storevars)
  (setq olderr *error*)
  (setq *error* adserror)
  (princ "\nSelect objects to change...")
  (setq mobjects (ssget))
  (setq mlength (sslength mobjects))
  (princ
    "\nSelect object whose properties you wish to match..."
  )
  (setq newlay (cdr (assoc 8 (setq newent (entget (car (entsel)))))))
  (setq newcolor (cdr (assoc 62 newent)))
  (setq newlinetype (cdr (assoc 6 newent)))
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (cond	(mobjects
	 (cond (newent
		(setq oldhighlight (getvar "highlight"))
		(setvar "highlight" 0)
		(command "change" mobjects "" "P" "LAYER" newlay)
	       )
	 )
	 (cond (newcolor (command "COLOR" newcolor))
	       (T (command "COLOR" "BYLAYER"))
	 )
	 (cond (newlinetype (command "LTYPE" newlinetype ""))
	       (T (command "LTYPE" "BYLAYER" ""))
	 )
	 (setvar "highlight" oldhighlight)
	)
  )
  (Princ "\nChanged properties of ")
  (princ mlength)
  (princ " entities.")
  (resetvars)
  (princ)
)

(defun c:Send (/      ed     CHAR   I	   c	  x	 a	b
	       f      bk     objs   obj	   ss	  objn	 pname	pname2
	       pnamef pnameb TS	    CLTmp  OldClr OLDLts ACVer	nam
	      )				; (Blim 1)
					;(if (= BlimError 0)
					;(progn
  (GetIni)
  (c:Con2SP)
  (setq nam (getvar "dwgname"))
  (setq I 1)
  (setq c 1)
  (setq a 0)
  (setq CHAR "")
  (while (and (setq CHAR (substr nam (setq I (1+ I)) 1))
	      (/= CHAR "")
	 )
    (if	(= CHAR "\\")
      (progn (setq c (+ I 1)))
    )
    (if	(= CHAR ".")
      (setq a I)
    )
  )
  (setq L (+ (- (strlen nam) c) 1))
  (setq nam (substr nam c L))
  (setq a (- a c))
  (if (> a 0)
    (setq nam (substr nam 1 a))
  )

  (setq ACVer (SUBSTR (getvar "AcadVer") 1 2))
  (if (= swss nil)
    (progn (setq Rot "0") (setq swss (ssget "X")))
  )
  (setvar "cmdecho" 0)
  (setq OLDLay (getvar "clayer"))
  (setq OLDClr (getvar "cecolor"))
  (setq bk nil)
  (command "_.SELECT" swss "")
  (setq Pname2 nil)
  (setq OBJS nil)
  (setq	OBJS
	 (SSGET	"P"
		(QUOTE
		  ((-4 . "<AND") (0 . "TEXT") (8 . "NAME") (-4 . "AND>"))
		)
	 )
  )
  (if (> OBJS nil)
    (progn
      (setq I -1)
      (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	(setq Pname2 (cdr (assoc 1 (entget OBJ))))
      )
    )
  )
  (if (= pname2 nil)
    (setq pname2 nam)
  )
  (command "_.SELECT" swss "")
  (setq OBJS (SSGET "P" (QUOTE ((6 . "DASHED")))))
  (if (> OBJS nil)
    (progn
      (setq OBJn nil)
      (command "_.SELECT" swss "")
      (setq OBJn
	     (SSGET
	       "P"
	       (QUOTE
		 ((-4 . "<AND") (0 . "TEXT") (8 . "NAME") (-4 . "AND>"))
	       )
	     )
      )
      (if (> OBJn nil)
	(progn				; BEGIN LOOP loop1.
	  (setq I -1)
	  (while (setq OBJ (ssname OBJn (setq I (1+ I))))
	    (setq ed (entget obj))
	    (setq Pname (cdr (assoc 1 (entget OBJ))))
	    (setq pnamef (strcat pname "F"))
	    (setq pnameb (strcat pname "B"))
	  )
	  (setq new (cons 1 pnamef))
	  (setq old (cons 1 Pname))
	  (setq ed (subst new old ed))
	  (entmod ed)
	)
      )
      (setq I -1)
      (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	(Entdel OBJ)
      )
      (princ "\rSending FRONT...")
      (command "_.SELECT" swss "")
      (setq ss (ssget "P"))
      (setq x (strcat dxfpath1 "tempF"))
      (PutDxf x ss)

      (setq x (strcat dxfpath2 Pname2 "F"))
      (if (= (substr dxfpath2 2 1) ":")
	(PutDxf x ss)
      )
      (setq I -1)
      (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	(Entdel OBJ)
      )
      (setq bk 1)
      (command "_.SELECT" swss "")
      (setq OBJS (SSGET "P" (QUOTE ((6 . "CONTINUOUS")))))
      (progn
	(if (> PName nil)
	  (progn
	    (setq new (cons 1 pnameb))
	    (setq old (cons 1 Pnamef))
	    (setq ed (subst new old ed))
	    (entmod ed)
	  )
	)

	(setq I -1)
	(if (> OBJS nil)
	  (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	    (Entdel OBJ)
	  )
	)
	(princ "\nSending BACK...")
	(command "_.SELECT" swss "")
	(setq ss (ssget "P"))
	(setq x (strcat dxfpath1 "tempB"))
	(PutDxf x ss)

	(setq x (strcat dxfpath2 Pname2 "B"))
	(if (= (substr dxfpath2 2 1) ":")
	  (PutDxf x ss)
	)
	(setq I -1)
	(if (> OBJS nil)
	  (while (setq OBJ (ssname OBJS (setq I (1+ I))))
	    (Entdel OBJ)
	  )
	)
	(setq OBJS nil)
      )
      (if (> PName nil)
	(progn (setq new (cons 1 pname))
	       (setq old (cons 1 Pnameb))
	       (setq ed (subst new old ed))
	       (entmod ed)
	)
      )
    )
    (progn
      (command "_.SELECT" swss "")
      (setq ss (ssget "P"))
      (setq x (strcat dxfpath1 "temp"))
      (PutDxf x ss)

      (setq x (strcat dxfpath2 Pname2))
      (if (= (substr dxfpath2 2 1) ":")
	(PutDxf x ss)
      )
    )
  )

  (setq a (strcat "TempB " nam "B"))
  (if (> bk nil)
    (setq b (strcat "TempF " nam "F"))
    (setq b (strcat "Temp " nam))
  )
  (setq x (strcat dxfpath1 "batch.lst"))
  (setq f (open x "w"))
  (if (> bk nil)
    (progn (prin1 a f) (princ (chr 10) f) (princ (chr 13) f))
  )
  (prin1 b f)
  (close f)
  (setvar "cecolor" OldClr)
  (setvar "clayer" OldLay)
  (setq swss nil)
  (command "Redraw")			;)
					;)
  (princ)
)

(defun c:SendWin (/ pt1 CHAR I c x a f ss obj TP) ;(Blim 1)
					;(if (= BlimError 0)
					;(progn				; Initialize the local state list to a default setting.
  (setq SWSS nil)
  (gc)
  (setvar "cmdecho" 0)
  (setq SWSS (ssget))
  (setq pt1 '(0 0))
  (setq	sel (strcase
	      (getstring
		"\r  Rotate 90 deg [L]eft, [R]ight, [F]lip 180 deg: "
	      )
	    )
  )
  (setq Rot "0")
  (if (= sel "L")
    (setq Rot "90")
  )
  (if (= sel "R")
    (setq Rot "-90")
  )
  (if (= sel "F")
    (setq Rot "180")
  )
  (command "rotate" SWSS "" pt1 Rot)
  (setq ss swss)
  (c:Send)
  (command "_.SELECT" ss ss "")
  (setq ss (ssget "P"))
  (if (= sel "L")
    (setq Rot "-90")
  )
  (if (= sel "R")
    (setq Rot "90")
  )
  (if (= sel "F")
    (setq Rot "180")
  )
  (command "rotate" SS "" pt1 Rot)
  (command "Redraw")			;)
					;)
  (princ)
)

(defun c:al400ed ()
  (setvar "cmdecho" 0)
  (c:Send)
  (setq x (getvar "dwgname"))
  (setq a (strcat "AL400ED /D Temp " x))
  (command "shell" a)
)

(defun c:WOut400 ()
  (setvar "cmdecho" 0)
  (c:SendWin)
  (setq x (getvar "dwgname"))
  (setq a (strcat "AL400ED /D Temp " x))
  (command "shell" a)
)

(defun c:ptp400	()
  (command "shell" "ed400 ")
)
(defun c:alink400 ()
  (setvar "cmdecho" 0)
  (c:Send)
  (setq x (getvar "dwgname"))
  (setq a (strcat "AL400 /D Temp " x))
  (command "shell" a)
)
(defun c:al400 ()
  (setvar "cmdecho" 0)
  (command "shell" "AL400")
)

(defun GetIni (/ si sl px char lchar x pth HDia VDia RTools)

  (setq si 1)
  (setq I -1)
  (setq px (getvar "acadprefix"))
  (while (and (setq CHAR (substr px (+ 1 (setq I (1+ I))) 1))
	      (/= CHAR "")
	 )
    (if	(equal char ";")
      (progn
	(setq sl (- I si))
	(setq sl (+ sl 1))
	(setq x (SUBSTR px si sl))
	(setq si (+ I 2))
	(if (equal lchar "\\")
	  (setq pth (strcat x "pnlmkr.ini"))
	  (setq pth (strcat x "\\pnlmkr.ini"))
	)
	(setq fp (open pth "r"))
	(if (> fp nil)
	  (progn
	    (setq dxfpath1 (read-line fp))
	    (setq dxfpath2 (read-line fp))
	    (setq BorderColor (read-line fp))
	    (setq VboreColor (read-line fp))
	    (setq HboreColor (read-line fp))
	    (setq GrooveColor (read-line fp))
	    (setq RouteColor (read-line fp))
	    (setq VDia (read-line fp))
	    (setq HDia (read-line fp))
	    (setq RTools (read-line fp))
	    (close fp)
	  )
	)
      )
      (setq Lchar char)
    )
  )

  
  (if (= DxfPath1 nil)
    (setq DxfPath1 "")
  )
  (if (/= (substr DxfPath1 2 1) ":")
    (setq DxfPath1 "c:\\dxf\\")
  )
  (if (= DxfPath2 nil)
    (setq DxfPath2 "")
  )

  (if (= BorderColor nil)
    (setq BorderColor "")
  )
  (if (= VboreColor nil)
    (setq VboreColor "")
  )
  (if (= HboreColor nil)
    (setq HboreColor "")
  )
  (if (= GrooveColor nil)
    (setq GrooveColor "")
  )
  (if (= RouteColor nil)
    (setq RouteColor "")
  )
  (if (= VDia nil)
    (setq VDia "")
  )
  (if (= HDia nil)
    (setq HDia "")
  )
  (if (= RTools nil)
    (setq RTools "")
  )
  (setq si 1)
  (setq I -1)
  (setq px VDia) 
  (start_list "VDIA")
  (while (and (setq CHAR (substr px (+ 1 (setq I (1+ I))) 1))
	      (/= CHAR "")
	 )
    (if	(equal char ";")
      (progn
	(setq sl (- I si))
	(setq sl (+ sl 1))
	(setq x (SUBSTR px si sl))
	(setq si (+ I 2))
	(start_list "VDIA" 2)
	(Add_List X)	
      )
    )
  )
  (End_List)
  (if (< (Strlen BorderColor) 1)
    (setq BorderColor "1")
  )
  (if (< (Strlen VboreColor) 1)
    (setq VboreColor "4")
  )
  (if (< (Strlen HboreColor) 1)
    (setq HboreColor "3")
  )
  (if (< (Strlen GrooveColor) 1)
    (setq GrooveColor "5")
  )
  (if (< (Strlen RouteColor) 1)
    (setq RouteColor "2")
  )
  (if (< (Strlen VDia) 1)
    (setq VDia "3")
  )
  (if (< (Strlen HDia) 1)
    (setq HDia "5")
  )
  (if (< (Strlen RTools) 1)
    (setq RTools "2")
  )
)

(defun PutDxf (x ss /)
 (setq wprog (substr (ver) 1 4))
 (if (= wprog "LISP")
  (command "dxfout" x "V" "5" "E" SS "" "6")
  (command "dxfout" x "V" "R12" "E" SS "" "6")
 )
;;; commented out the following section so the program will default to R13 DXF format
  
 ; (if (= ACVer "14")
 ;   (command "dxfout" x "V" "R13" "E" SS "" "6")
 ;   (command "dxfout" x "E" SS "" "6")
 ; )
 ; (if (= ACVer "15")
 ;   (command "dxfout" x "V" "R13" "E" SS "" "6")
 ;   (command "dxfout" x "E" SS "" "6")
 ; )
);defun PutDxf

(defun C:MenuPM	(/)
  (command "menuload" "pnlmkr")
  (menucmd "P10=+pnlmkr.pop1")
)
(defun dxf(code elist)
  (cdr (assoc code elist))
);defun


(defun c:Con2SP	(/ OBJS I)
  (setq OBJS (SSGET "X" (QUOTE ((0 . "LWPOLYLINE") (67 . 0)))))
  (if (> OBJS nil)
    (progn
	(setq I -1)
  	(while (setq ent2ox (ssname OBJS (setq I (1+ I))))
    	  (c:LW2SP)
	)
    )
  )
  (prin1)
)


(defun c:LW2SP (/ ent_x der_calque calque plinetype)

  (setvar "cmdecho" 0)

  (princ "\nConvert LWPOLYLINE to POLYLINE.")

					; Sélection de la polyligne

  (if (= ent2ox nil)
    (setq ent2ox (car (entsel "\nSelect LwPolyline: ")))
  )

  (if (= (cdr (assoc 0 (entget ent2ox))) "LWPOLYLINE")
    (progn

					; Mémorisation de la variable PLINETYPE
					; 0 pas de création polyligne optimisée

      (setq plinetype (getvar "plinetype"))

      (setvar "plinetype" 0)

      (setq der_calque (getvar "clayer"))


      (command "_ucs" "_ob" ent2ox)

      (setq calque (cdr (assoc 8 (entget ent2ox))))

					; création d'un calque sur lequel on transfère l'objet

      (command "_layer" "_m" "$$LP2SP" "")
      (command "_chprop" ent2ox "" "_la" "$$LP2SP" "")

					; on décompose l'objet pour conserver ses arcs et courbes
					; si elles existent

      (command "_explode" ent2ox)
      (setq ent2ox nil)

					; on sélectionne tous les objets de ce calque

      (setq ent_x (ssget "x" (list (cons 8 "$$LP2SP"))))


					; on recompose la polyligne non optimisée

      (command "_pedit" (ssname ent_x 0) "_y" "_j" ent_x "" "")

      (setq ent_x (entlast))

					; on replace la polyligne sur son calque d'origine

      (command "_chprop" ent_x "" "_la" calque "")

					; on rétablit les variables d'origines

      (command "_ucs" "_p")

      (setvar "plinetype" plinetype)

      (command "_layer" "_m" der_calque "")

					; on purge le calque de transfert

      (command "_purge" "_layer" "$$LP2SP" "_n")

      (princ "\nEnd Convert.")

    )
    (alert "Not a LwPolyline.")
  )
  (princ)

)
;;;==============================================================================================
;;;
;;; Sub function TestOKbore

(defun TestOKbore ( VORH )
  (setq BK (atoi (Get_Tile "Bk")))
  (setq FR (atoi (Get_Tile "Fr")))
  (setq UL (atoi (Get_Tile "UL")))
  (setq UR (atoi (Get_Tile "UR")))
  (setq LL (atoi (Get_Tile "LL")))
  (setq LR (atoi (Get_Tile "LR")))
  (if (= VORH "V")
    (setq VX (atof (Get_Tile "VX"))
          VY (atof (Get_Tile "VY"))
          VZ (atof (Get_Tile "VZ"))
    )
    (setq XY (atof (Get_Tile "XY"))
          VZ (atof (Get_Tile "VZ"))
          HD (atof (Get_Tile "HD"))
    )
  )  
  (setq VDia (atoi (Get_Tile "VDIA")))
  (setq SVDia (atof (Get_Tile "SVDIA")))
  (setq TN (atoi (Get_Tile "TN")))
  (setq VNUM (atoi (Get_Tile "VNUM")))
  (setq VDIST (atof (Get_Tile "VDIST")))
  (setq VH (atoi (Get_Tile "VH")))
  (setq VV (atoi (Get_Tile "VV")))
  (foreach n (list 0.0 5.0 8.0 10.0 12.0 14.0 18.0 25.0 35.0 0.25 0.5)
    (if (= SVDia n)
      (setq vdia (- 11 (length (member n (list 0.0 5.0 8.0 10.0 12.0 14.0 18.0 25.0 35.0 0.25 0.5)))))
    )
  )
  (if (= VORH "V")
    (setq VBOREGlobalStateList (list (cons "Fr" (rtos FR 2 0))(cons "Bk" (rtos BK 2 0))(cons "UL" (rtos UL 2 0))(cons "UR" (rtos UR 2 0))(cons "LL" (rtos LL 2 0))(cons "LR" (rtos LR 2 0))(cons "VX" (rtos VX 2))(cons "VY" (rtos VY 2))(cons "VZ" (rtos VZ 2))(cons "VDIA" (rtos VDIA 2 0))(cons "SVDIA" (rtos SVDIA 2))(cons "VNUM" (rtos VNUM 2 0))(cons "VDIST" (rtos VDIST 2))(cons "VH" (rtos VH 2 0))(cons "VV" (rtos VV 2 0))(cons "TN" (rtos TN 2 0))) 
          #VBOREGlobalDialogPos (done_dialog 1)
    );setq 
    (setq HBOREGlobalStateList (list (cons "Fr" (rtos FR 2 0))(cons "Bk" (rtos BK 2 0))(cons "UL" (rtos UL 2 0))(cons "UR" (rtos UR 2 0))(cons "LL" (rtos LL 2 0))(cons "LR" (rtos LR 2 0))(cons "XY" (rtos XY 2))(cons "VZ" (rtos VZ 2))(cons "HD" (rtos HD 2))(cons "VDIA" (rtos VDIA 2 0))(cons "SVDIA" (rtos SVDIA 2))(cons "VNUM" (rtos VNUM 2 0))(cons "VDIST" (rtos VDIST 2))(cons "VH" (rtos VH 2 0))(cons "VV" (rtos VV 2 0))(cons "TN" (rtos TN 2 0))) 
          #HBOREGlobalDialogPos (done_dialog 1)
    );setq
  )
);defun TestOKbore
(princ)