;;;Lisp function: (huandx)
;;;     and other supporting lisp subroutines are included in this file.
;;;
;;;     (huandx) Creates/Updates HUANDX.TXT - a sorted index of project
;;;     drawing names, sheet nos., titles, and area info for viewports.
;;;     This information is used by the commands below.
;;;
;;;Requirements:
;;;     Block named *TTBAT.  It can be
;;;     customized but it must contain all attributes in the original
;;;     HUATTBAT and be named as indicated.  Unneeded attributes can be
;;;     left blank or "parked" outside the sheet area.  Attributes are
;;;     for Title block fill-in. Only drawings containing one of these
;;;     blocks are considered to be sheets in the project document set.
;;;
;;;Commands: Shtndx, Shtbnd, Viewsht, Esbnd, Bproj
;;;
;;;Use SHTNDX to create a complete drawing index from HUANDX.TXT.
;;;Use SHTBND to create sheet number labels and rectangles outlining all
;;;    viewport areas for all sheets.
;;;Use VIEWSHT to zoom to any viewport area of any sheet.  Examine
;;;    coordinate values to help select plan, profile or detail views.
;;;Use BPROJ to automatically compile the ordered list of project sheets
;;;    for plotting and start BPLOT ready to plot them all.
;;;
;;;HUANDX.TXT Notes:
;;;
;;;       Use EDTXT to open HUANDX.TXT in Notepad.  Open HUANDX.TXT to
;;;       view drawing names and their associated sheet numbers (a very
;;;       handy reference).
;;;
;;;       HUANDX should be manually sorted after new sheets are added.
;;;       Once the list is complete and has been sorted it will not need
;;;       sorting again.
;;;
;;;       Do not use word wrap! Sheet info must occupy only one line in
;;;       the file.
;;;
;;;       Sheets that belong to the project but are kept elsewhere can
;;;       be manually added (vport info may be omitted) so SHTNDX will
;;;       produce the complete sheet index.
;;;
;;;       Add BOGUS drawing names and titles to provide section headings
;;;       such as CIVIL, MECHANICAL, STRUCTURAL, ELECTRICAL, etc.
;;;
;;;       Corrected vpbnd subroutine to translate viewport bounds from UCS
;;;       to WCS
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 4-22-97
;;;>		   EDITED: 08-28-2006
;;;
(DEFUN huandx
	      (/			;attlst
	       ttl1ss	iniblk	 inient	  nxtent   dwg_#    sht_#
	       dsgnd	drwn	 chkd	  dscale   sub_by   desdir
	       ttl11	ttl13	 ttl33	  ttl14	   ttl12    ttl22
	       ttl44	ndx_df	 rd_lin	  wf_lst   datlst   ttllst
	      )
  (SETQ ttl_exst nil)
  (IF
    (SETQ ttl1ss (SSGET	"x"
			(LIST
			  (CONS -4 "<and")
			  (CONS 0 "INSERT")
			  (CONS 410 (GETVAR "ctab"))
			  (CONS -4 "<or")
			  (CONS 2 "*TTBAT")
			  (CONS 2 "*TTBAT?")
			  (CONS 2 "TB_ATT?")
			  (CONS -4 "or>")
			  (CONS -4 "and>")
			) ;_ end of list
		 ) ;_ end of ssget
    ) ;_ end of setq
     (PROGN


       (IF (> (SSLENGTH ttl1ss) 1)
	 (PRINC
	   "\nMore than one block with title attributes is in the drawing. "
	 ) ;_ end of princ
	 (PROGN
	   (SETQ dwg_name (GETVAR "dwgname"))
	   (SETQ iniblk (SSNAME ttl1ss 0))
	   (SETQ inient (ENTGET iniblk))
	   (SETQ attlst nil)
	   (SETQ nxtent (ENTGET (ENTNEXT iniblk)))
	   (WHILE (/= (CDR (ASSOC 0 nxtent)) "SEQEND")
	     (IF (EQ (CDR (ASSOC 0 nxtent)) "ATTRIB")
	       (IF attlst
		 (SETQ attlst
			(APPEND	attlst
				(LIST (ASSOC 2 nxtent) (ASSOC 1 nxtent))
			) ;_ end of append
		 ) ;_ end of setq
		 (SETQ attlst (LIST (ASSOC 2 nxtent) (ASSOC 1 nxtent)))
	       ) ;_ end of if
	     ) ;_ end of if
	     (SETQ nxtent (ENTGET (ENTNEXT (CDAR nxtent))))
	   )				;while
	   (IF attlst
	     (PROGN
	       (IF (OR (MEMBER (CONS 2 "FIG_NO.") attlst)
		       (MEMBER (CONS 2 "SHT_NO.") attlst)
		       (MEMBER (CONS 2 "XX") attlst)
		   ) ;_ end of OR
		 (COND
		   ((MEMBER (CONS 2 "FIG_NO.") attlst)
		    (SETQ
		      sht_# (CDADR (MEMBER (CONS 2 "FIG_NO.") attlst))
		    ) ;_ end of SETQ
		   )
		   ((MEMBER (CONS 2 "SHT_NO.") attlst)
		    (SETQ
		      sht_# (CDADR (MEMBER (CONS 2 "SHT_NO.") attlst))
		    ) ;_ end of SETQ
		   )
		   ((MEMBER (CONS 2 "XX") attlst)
		    (SETQ sht_# (CDADR (MEMBER (CONS 2 "XX") attlst)))
		   )
		 ) ;_ end of COND
		 (SETQ sht_# "")
	       ) ;_ end of if
	     ) ;_ end of progn
	   ) ;_ end of if
	   (vpbnds)
	 ) ;_ end of progn
       ) ;_ end of if


       (IF (MEMBER (CONS 2 "TITLE_1/4") attlst)
	 (SETQ ttl_1/4 (CDADR (MEMBER (CONS 2 "TITLE_1/4") attlst)))
	 (SETQ ttl_1/4 "")
       ) ;_ end of if
       (IF (OR (MEMBER (CONS 2 "TITLE_1/2") attlst)
	       (MEMBER (CONS 2 "SHEET_TITLE_1") attlst)
	   ) ;_ end of OR
	 (COND
	   ((MEMBER (CONS 2 "TITLE_1/2") attlst)
	    (SETQ ttl_1/2 (CDADR (MEMBER (CONS 2 "TITLE_1/2") attlst)))
	   )
	   ((MEMBER (CONS 2 "SHEET_TITLE_1") attlst)
	    (SETQ
	      ttl_1/2 (CDADR (MEMBER (CONS 2 "SHEET_TITLE_1") attlst))
	    ) ;_ end of SETQ
	   )
	 ) ;_ end of COND
	 (SETQ ttl_1/2 " ")
       ) ;_ end of if
       (IF (OR (MEMBER (CONS 2 "TITLE_2/2") attlst)
	       (MEMBER (CONS 2 "SHEET_TITLE_2") attlst)
	   ) ;_ end of OR
	 (COND
	   ((MEMBER (CONS 2 "TITLE_2/2") attlst)
	    (SETQ ttl_2/2 (CDADR (MEMBER (CONS 2 "TITLE_2/2") attlst)))
	   )
	   ((MEMBER (CONS 2 "SHEET_TITLE_2") attlst)
	    (SETQ
	      ttl_2/2 (CDADR (MEMBER (CONS 2 "SHEET_TITLE_2") attlst))
	    ) ;_ end of SETQ
	   )
	 ) ;_ end of COND
	 (SETQ ttl_2/2 "")
       ) ;_ end of if
       (IF (MEMBER (CONS 2 "TITLE_4/4") attlst)
	 (SETQ ttl_4/4 (CDADR (MEMBER (CONS 2 "TITLE_4/4") attlst)))
	 (SETQ ttl_4/4 "")
       ) ;_ end of if
       (IF (MEMBER (CONS 2 "TITLE_1/5") attlst)
	 (SETQ ttl_1/5 (CDADR (MEMBER (CONS 2 "TITLE_1/5") attlst)))
	 (SETQ ttl_1/5 "")
       ) ;_ end of if
       (IF (MEMBER (CONS 2 "TITLE_1/3") attlst)
	 (SETQ ttl_1/3 (CDADR (MEMBER (CONS 2 "TITLE_1/3") attlst)))
	 (SETQ ttl_1/3 "")
       ) ;_ end of if
       (IF (MEMBER (CONS 2 "TITLE_1") attlst)
	 (SETQ ttl_1 (CDADR (MEMBER (CONS 2 "TITLE_1") attlst)))
	 (SETQ ttl_1 "")
       ) ;_ end of if
       (IF (MEMBER (CONS 2 "TITLE_3/3") attlst)
	 (SETQ ttl_3/3 (CDADR (MEMBER (CONS 2 "TITLE_3/3") attlst)))
	 (SETQ ttl_3/3 "")
       ) ;_ end of if
       (IF (MEMBER (CONS 2 "TITLE_5/5") attlst)
	 (SETQ ttl_5/5 (CDADR (MEMBER (CONS 2 "TITLE_5/5") attlst)))
	 (SETQ ttl_5/5 "")
       ) ;_ end of if
       (IF (AND	ttl_1/5
		(> (STRLEN ttl_1/5) 0)
		ttl_1
		(> (STRLEN ttl_1) 0)
		ttl_1/3
		(> (STRLEN ttl_1/3) 0)
		ttl_3/3
		(> (STRLEN ttl_3/3) 0)
		ttl_5/5
		(> (STRLEN ttl_5/5) 0)
	   ) ;_ end of and
	 (SETQ ttl (STRCAT dwg_name
			   "\t"
			   sht_#
			   "\t"
			   ttl_1/5
			   " "
			   ttl_1/3
			   " "
			   ttl_1
			   " "
			   ttl_3/3
			   " "
			   ttl_5/5
			   "\t"
			   (IF bnd_lst
			     bnd_lst
			     ""
			   ) ;_ end of if
		   ) ;_ end of strcat
	 ) ;_ end of setq
	 (IF (AND ttl_1/3
		  (> (STRLEN ttl_1/3) 0)
		  ttl_1
		  (> (STRLEN ttl_1) 0)
		  ttl_3/3
		  (> (STRLEN ttl_3/3) 0)
	     ) ;_ end of and
	   (SETQ ttl (STRCAT dwg_name
			     "\t"
			     sht_#
			     "\t"
			     ttl_1/3
			     " "
			     ttl_1
			     " "
			     ttl_3/3
			     "\t"
			     (IF bnd_lst
			       bnd_lst
			       ""
			     ) ;_ end of if
		     ) ;_ end of strcat
	   ) ;_ end of setq
	   (IF (AND ttl_1 (> (STRLEN ttl_1) 0))
	     (SETQ ttl (STRCAT dwg_name
			       "\t"
			       sht_#
			       "\t"
			       ttl_1
			       "\t"
			       (IF bnd_lst
				 bnd_lst
				 ""
			       ) ;_ end of if
		       ) ;_ end of STRCAT
	     ) ;_ end of SETQ
	     (IF (AND ttl_1/4
		      (> (STRLEN ttl_1/4) 0)
		      ttl_1/2
		      (> (STRLEN ttl_1/2) 0)
		      ttl_2/2
		      (> (STRLEN ttl_2/2) 0)
		      ttl_4/4
		      (> (STRLEN ttl_4/4) 0)
		 ) ;_ end of and
	       (SETQ ttl (STRCAT dwg_name
				 "\t"
				 sht_#
				 "\t"
				 ttl_1/4
				 " "
				 ttl_1/2
				 " "
				 ttl_2/2
				 " "
				 ttl_4/4
				 "\t"
				 (IF bnd_lst
				   bnd_lst
				   ""
				 ) ;_ end of if
			 ) ;_ end of strcat
	       ) ;_ end of setq
	       (IF (AND	ttl_1/2
			(> (STRLEN ttl_1/2) 0)
		   ) ;_ end of and
		 (SETQ ttl (STRCAT dwg_name
				   "\t"
				   sht_#
				   "\t"
				   ttl_1/2
				   " "
				   ttl_2/2
				   "\t"
				   (IF bnd_lst
				     bnd_lst
				     ""
				   ) ;_ end of if
			   ) ;_ end of IF
		 ) ;_ end of setq
		 (SETQ ttl nil)
	       ) ;_ end of if
	     ) ;_ end of if
	   ) ;_ end of if
	 ) ;_ end of if
       ) ;_ end of PROGN

       (IF (AND
	     (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\?*")
	     (OR
	       (WCMATCH (GETVAR "DWGPREFIX") "*800*\\## @*\\")
	       (WCMATCH (GETVAR "DWGPREFIX") "*800*\\*\\")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\CIV*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\SITE*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\ARCH*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\STRU*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\MECH*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\PLUM*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\HVAC*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\ELEC*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\INST*")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\GRAPHICS\\")
	       (WCMATCH (GETVAR "DWGPREFIX") "*\\0CAD\\XREF*")
	     ) ;_ end of OR
	   ) ;_ end of AND
	 (PROGN
	   (SETQ
	     up1_dir (DOS_CHDIR (STRCAT (GETVAR "DWGPREFIX") "..\\"))
	   ) ;_ end of SETQ
	   (WHILE (NOT (WCMATCH up1_dir "*\\0CAD\\"))
	     (SETQ up1_dir (DOS_CHDIR (STRCAT up1_dir "..\\")))
	   ) ;_ end of WHILE
	   (SETQ huandx_dir up1_dir)
	 ) ;_ end of PROGN
	 (SETQ huandx_dir (GETVAR "DWGPREFIX"))
       ) ;_ end of IF
       (IF ttl
	 (IF (FINDFILE (STRCAT huandx_dir "huandx.txt"))
	   (PROGN
	     (SETQ nxfile (OPEN	(STRCAT huandx_dir "huandx.txt")
				"r"
			  ) ;_ end of open
		   nxlist nil
	     ) ;_ end of setq
	     (WHILE (SETQ nxrdln (READ-LINE nxfile))
	       (SETQ nxlist (APPEND nxlist (LIST nxrdln)))
	     ) ;_ end of while
	     (SETQ xnxlst nxlist)
	     (CLOSE nxfile)
	     (SETQ TTLCNT 1)
	     (WHILE
	       (AND
		 (/= (STRCASE (SUBSTR TTL TTLCNT 4)) ".DWG")
		 (<= TTLCNT (STRLEN TTL))
		 (<= TTLCNT 32)
	       ) ;_ end of AND
		(SETQ TTLCNT (1+ TTLCNT))
	     ) ;_ end of WHILE
	     (FOREACH n	nxlist
	       (IF
		 (EQ (STRCASE (STRCAT (SUBSTR ttl 1 (1- TTLCNT)) ".DWG"))
		     (STRCASE (STRCAT (SUBSTR n 1 (1- TTLCNT)) ".DWG"))
		 ) ;_ end of EQ
		  (SETQ	nxlist	 (SUBST ttl n nxlist)
			ttl_exst T
		  ) ;_ end of setq
	       ) ;_ end of IF
	     ) ;_ end of foreach
	     (IF ttl_exst
	       nil
	       (SETQ nxlist (APPEND nxlist (LIST ttl)))
	     ) ;_ end of if
	     (IF (EQ xnxlst nxlist)
	       nil
	       (PROGN
		 (SETQ nxfile
			(OPEN (STRCAT huandx_dir "huandx.txt")
			      "w"
			) ;_ end of open
		 ) ;_ end of setq
		 (FOREACH n nxlist
		   (WRITE-LINE n nxfile)
		 ) ;_ end of foreach
		 (CLOSE nxfile)
	       ) ;_ end of progn
	     ) ;_ end of if
	     (PRINC (STRCAT "\n  Index file "
			    huandx_dir
			    "HUANDX.TXT has been updated. \n"
		    ) ;_ end of strcat
	     ) ;_ end of princ
	   ) ;_ end of progn
	   (PROGN
	     (SETQ
	       nxfile (OPEN (STRCAT huandx_dir "huandx.txt")
			    "w"
		      ) ;_ end of open
	     ) ;_ end of setq
	     (WRITE-LINE ttl nxfile)
	     (CLOSE nxfile)
	     (PRINC (STRCAT "\n  Index file "
			    huandx_dir
			    "HUANDX.TXT has been created. \n"
		    ) ;_ end of strcat
	     ) ;_ end of princ
	   ) ;_ end of progn
	 ) ;_ end of if
	 (PRINC)
       ) ;_ end of if
     ) ;_ end of progn
     (PRINC)
  ) ;_ end of if
  (SETQ oldatlst attlst)
  (PRINC)
) ;_ end of defun
;;;(LOAD "SHTBND" "\nFile SHTBND.LSP not found! ")
;;;Loading SHTBND defuns C:SHTBND, C:VIEWSHT, and C:ESBND
(DEFUN vpbnds ()
  (IF (AND (= (GETVAR "cvport") 1) (EQ (GETVAR "tilemode") 0))
    (PROGN
      (SETQ do_zoomp T)
      (COMMAND ".zoom" "w" (GETVAR "extmin") (GETVAR "extmax"))
      (COMMAND ".mspace")
    ) ;_ end of progn
    (PROGN
      (SETQ do_zoomp T)
      (COMMAND ".pspace")
      (COMMAND ".zoom" "w" (GETVAR "extmin") (GETVAR "extmax"))
      (COMMAND ".mspace")
    ) ;_ end of progn
  ) ;_ end of if
  (SETQ vportss (SSGET "x" (LIST(CONS 0 "VIEWPORT")(CONS 410(GETVAR "CTAB")))))
  (SETQ vpsslen (SSLENGTH vportss))
  (SETQ cnt 0)
  (SETQ	vpdatlst nil
	bnd_lst	nil
  ) ;_ end of setq
  (WHILE (< cnt vpsslen)
    (SETQ vpdat (ENTGET (SSNAME vportss cnt)))
    (IF
      (AND (/= (CDR (ASSOC 8 vpdat)) "0")
	   (NOT
	     (WCMATCH (STRCASE (CDR (ASSOC 8 vpdat))) (STRCASE "*vi00*"))
	   ) ;_ end of NOT
	   (> (CDR (ASSOC 68 vpdat)) 0)
      ) ;_ end of and
       (SETQ vpdatlst
	      (APPEND
		(LIST (CONS (READ (SUBSTR (CDR (ASSOC 8 vpdat)) 5 2))
			    (CDR (ASSOC 69 vpdat))
		      ) ;_ end of cons
		) ;_ end of list
		vpdatlst
	      ) ;_ end of append
       ) ;_ end of setq
    ) ;_ end of if
    (SETQ cnt (1+ cnt))
  ) ;_ end of while
					;  (if (< (length vpdatlst) 7)
  (FOREACH n vpdatlst
    (IF	(CDR n)
;;;      NIL
      (PROGN
	(SETVAR "cvport" (CDR n))
;;;	(SETQ cvputw (- (* PI 2) (GETVAR "viewtwist")))
;;;	(REGAPP "ACAD")
	(SETQ cvpss (SSGET "X" (LIST (CONS 69 (CDR n)))))
	(SETQ cvpent (ENTGET (SSNAME cvpss 0) (LIST "ACAD")))
	(SETQ cvpvno (ATOI (SUBSTR (CDR (ASSOC 8 cvpent)) 5 2)))
;;;	(SETQ cvphgt (GETVAR "viewsize"))
	(SETQ cvphgt (CDR (ASSOC 45 cvpent)))
					; assoc 45 is view height in model space units
	(SETQ cvpctr (TRANS (GETVAR "viewctr") 1 0))
	(SETQ cvputw (- (* PI 2) (CDR (ASSOC 51 cvpent))))
					; assoc 51 is viewtwist angle
;;;	(SETQ cvpctr (CDR (ASSOC 10 cvpent))); center point in paper space WCS
	(SETQ cvpa40 (CDR (ASSOC 40 cvpent)))
					; width in paper space units
	(SETQ cvpa41 (CDR (ASSOC 41 cvpent)))
					; height in paper space units
	(SETQ cvpwid (* (/ cvpa40 cvpa41) cvphgt))
					;    (setq xvdata (cadr(assoc -3 cvpent)))
	(SETQ pt1
		  (POLAR (POLAR cvpctr cvputw (/ cvpwid 2))
			 (- cvputw (/ PI 2))
			 (/ cvphgt 2)
		  ) ;_ end of polar
	      pt2 (POLAR pt1 (+ cvputw (/ PI 2)) cvphgt)
	      pt3 (POLAR pt2 (+ cvputw PI) cvpwid)
	      pt4 (POLAR pt3 (- cvputw (/ PI 2)) cvphgt)
	) ;_ end of setq
;;;	(SETQ pt1 (TRANS
;;;		    (POLAR (POLAR cvpctr cvputw (/ cvpwid 2))
;;;			   (- cvputw (/ PI 2))
;;;			   (/ cvphgt 2)
;;;		    ) ;_ end of polar
;;;		    (CDR (ASSOC -1 cvpent))
;;;		    0
;;;		  )
;;;	      pt2 (TRANS (POLAR pt1 (+ cvputw (/ PI 2)) cvphgt) (CDR (ASSOC -1 cvpent)) 0)
;;;	      pt3 (TRANS (POLAR pt2 (+ cvputw PI) cvpwid) (CDR (ASSOC -1 cvpent)) 0)
;;;	      pt4 (TRANS (POLAR pt3 (- cvputw (/ PI 2)) cvphgt) (CDR (ASSOC -1 cvpent)) 0)
;;;	) ;_ end of setq
	(IF bnd_lst
	  (SETQ	bnd_lst
		 (STRCAT bnd_lst
			 (CHR 40)
			 "\""
			 sht_#
			 "\""
			 (CHR 40)
			 (RTOS (CAR pt1) 2 2)
			 " "
			 (RTOS (CADR pt1) 2 2)
			 (CHR 41)
			 (CHR 40)
			 (RTOS (CAR pt2) 2 2)
			 " "
			 (RTOS (CADR pt2) 2 2)
			 (CHR 41)
			 (CHR 40)
			 (RTOS (CAR pt3) 2 2)
			 " "
			 (RTOS (CADR pt3) 2 2)
			 (CHR 41)
			 (CHR 40)
			 (RTOS (CAR pt4) 2 2)
			 " "
			 (RTOS (CADR pt4) 2 2)
			 (CHR 41)
			 (CHR 41)
		 ) ;_ end of strcat
	  ) ;_ end of setq
	  (SETQ	bnd_lst
		 (STRCAT (CHR 40)
			 "\""
			 sht_#
			 "\""
			 (CHR 40)
			 (RTOS (CAR pt1) 2 2)
			 " "
			 (RTOS (CADR pt1) 2 2)
			 (CHR 41)
			 (CHR 40)
			 (RTOS (CAR pt2) 2 2)
			 " "
			 (RTOS (CADR pt2) 2 2)
			 (CHR 41)
			 (CHR 40)
			 (RTOS (CAR pt3) 2 2)
			 " "
			 (RTOS (CADR pt3) 2 2)
			 (CHR 41)
			 (CHR 40)
			 (RTOS (CAR pt4) 2 2)
			 " "
			 (RTOS (CADR pt4) 2 2)
			 (CHR 41)
			 (CHR 41)
		 ) ;_ end of strcat
	  ) ;_ end of setq
	) ;_ end of if
      ) ;_ end of PROGN
    ) ;_ end of IF
  ) ;_ end of foreach
  (IF bnd_lst
    (SETQ bnd_lst (STRCAT (CHR 40) bnd_lst (CHR 41)))
  ) ;_ end of if
  (COMMAND ".pspace")
  (IF do_zoomp
    (COMMAND ".zoom" "p")
  ) ;_ end of if
) ;_ end of defun

;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
 ***Don't add text below the comment!***|;