;;;Requirements:
;;;
;;;This Drawing (block) must exist on AutoCAD's search path (or in the drawing):
;;;	##ppgridlbl
;;;		(#'s are wildcards which must be replaced with digits representing profile horizontal scale)
;;;		These blocks must contain specific attribute tags for elevations,
;;;	i.e.:
;;;
;;;	left side attribute tags (ordered before right side tags)
;;;		MLB+0, MLB+5, MLB+10, etc. but ordered from highest MLB+## to MLB+0;
;;;		Space these vertically at 1" unscaled (english), unit distance (metric)
;;;		(The total number of these tags is unlimited)
;;;
;;;	right side attribute tags
;;;		MRB+0, MRB+5, MRB+10, etc. also ordered from highest MRB+## to MRB+0;
;;;		(The total number of these tags is unlimited)
;;;
;;;Drawing must contain:
;;;	The profile viewport on layer "*VI01*NPLT*" (preferably "??VI01?NPLT" per CLG)
;;;	The profile grid block named "##ppgrid" or "##spclgrid" or "##spfbgrid"
;;;		(#'s are wildcards which must be replaced with digits representing profile horizontal scale)
;;;		These profile grid blocks must contain specific attribute tags for stations and elevations,
;;;	i.e.:
;;;
;;;	left side attribute tags (ordered before right side tags)
;;;		LB+0, LB+5, LB+10, etc. but ordered from highest LB+## to LB+0;
;;;		(The total number of these tags is unlimited)
;;;
;;;	right side attribute tags
;;;		RB+0, RB+5, RB+10, etc. also ordered from highest RB+## to RB+0;
;;;		(The total number of these tags is unlimited)
;;;
;;;	station attribute tags
;;;;		0, +0, 1, +1, 2, +2, etc. from left to right as many as are required
;;;		place these in pairs at scaled 100' increments (english), 50m increments (metric).
;;;		integer tags are right justified and +integer tags are left justified so that the first character,
;;;		typically a plus sign (+), will lay directly under the grid line.  This solves justification related
;;;		misalignment of labels.
;;;		(The total number of these tags is unlimited)
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 4-16-95
;;;>		   EDITED: 09-22-2005
;;;
(DEFUN splitvp_error (msg /)
  (PRINC (STRCAT "\nError: " msg))
  (PRINC "\nEnter UNDO/END and then U to undo SPLITVP.\n")
  (IF old_splitvp_error
    (SETQ *ERROR* old_splitvp_error)
  ) ;_ end of IF
  (IF old_splitvp_osmode
    (SETVAR "OSMODE" old_splitvp_osmode)
  ) ;_ end of IF
  (IF old_splitvp_attreq
    (SETVAR "ATTREQ" old_splitvp_attreq)
  ) ;_ end of IF
  (IF old_splitvp_attdia
    (SETVAR "ATTDIA" old_splitvp_attdia)
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:SPLITVP (/) ;vpss lblss
  (SETQ vpss NIL
        lblss NIL
        allvpss NIL
        notvpss NIL
  ) ;_ end of SETQ
  (SETQ old_splitvp_error *ERROR*)
  (SETQ *ERROR* splitvp_error)
  (SETQ old_splitvp_osmode (GETVAR "OSMODE"))
  (SETQ old_splitvp_attreq (GETVAR "ATTREQ"))
  (SETQ old_splitvp_attdia (GETVAR "ATTDIA"))
  (COMMAND ".undo" "BEGIN")
  (SETVAR "attreq" 0)
  (SETVAR "attdia" 0)
  (SETQ vpss (SSGET "X" '((0 . "VIEWPORT") (8 . "*VI01*NPLT*"))))
  (IF vpss     ;(AND vpss (EQ (SSLENGTH vpss) 1))
    (PROGN
      (IF (EQ (SSLENGTH vpss) 1)
        NIL
        (PROGN (SETQ vpsslen (SSLENGTH vpss)
                     sscnt   0
               ) ;_ end of SETQ
               (WHILE (< sscnt vpsslen)
                 (SETQ cntvpdef (ENTGET (SSNAME vpss sscnt))
                       cntvplay (CDR (ASSOC 8 cntvpdef))
                 ) ;_ end of SETQ
                 (SETQ cntvplaydef (ENTGET (TBLOBJNAME "LAYER" cntvplay)))
                 (IF (EQ (BOOLE 1 1 (CDR (ASSOC 70 cntvplaydef))) 1)
                   (PROGN (COMMAND ".layer" "t" cntvplay "")
                          (IF (< (CDR (ASSOC 62 cntvplaydef)) 0)
                            (COMMAND ".layer" "on" cntvplay "")
                          ) ;_ end of IF
                          (ENTUPD (CDR (ASSOC -1 cntvpdef)))
                   ) ;_ end of PROGN
                   (PROGN (IF (< (CDR (ASSOC 62 cntvplaydef)) 0)
                            (COMMAND ".layer" "on" cntvplay "")
                          ) ;_ end of IF
                          (ENTUPD (CDR (ASSOC -1 cntvpdef)))
                   ) ;_ end of PROGN
                 ) ;_ end of IF
                 (SETQ sscnt (1+ sscnt))
               ) ;_ end of WHILE
               (PRINC "\nSelect viewport to split ")
               (SETQ vpss (SSGET '((0 . "VIEWPORT"))))
        ) ;_ end of PROGN
      ) ;_ end of IF
      (SETQ vpdef   (ENTGET (SSNAME vpss 0))
            vpwid   (CDR (ASSOC 40 vpdef))
            vphgt   (CDR (ASSOC 41 vpdef))
            vpcen   (CDR (ASSOC 10 vpdef))
            vpll_pt (LIST (- (CAR vpcen) (/ vpwid 2.0)) (- (CADR vpcen) (/ vphgt 2.0)) 0)
            vplr_pt (LIST (+ (CAR vpcen) (/ vpwid 2.0)) (- (CADR vpcen) (/ vphgt 2.0)) 0)
            vpur_pt (LIST (+ (CAR vpcen) (/ vpwid 2.0)) (+ (CADR vpcen) (/ vphgt 2.0)) 0)
            vpul_pt (LIST (- (CAR vpcen) (/ vpwid 2.0)) (+ (CADR vpcen) (/ vphgt 2.0)) 0)
            vpmsc   (CDR (ASSOC 12 vpdef))
            vpmsh   (CDR (ASSOC 45 vpdef))
            vpscl   (/ vpmsh vphgt)
            vplay   (CDR (ASSOC 8 vpdef))
      ) ;_ end of SETQ
      (IF (ASSOC 340 (ENTGET (SSNAME vpss 0)))
        (SETQ vpss (SSADD (CDR (ASSOC 340 (ENTGET (SSNAME vpss 0)))) vpss))
      ) ;_ end of IF
      (SETQ lblss (SSGET "X" '((0 . "INSERT") (2 . "*##ppbrklbl"))))
      (IF upoint
        NIL
        (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
      ) ;_ end of IF
      (SETQ splitpt (upoint 1 "" "Pick split location" nil nil))
      (SETVAR "OSMODE" 0)
      (SETQ spptbot (LIST (CAR splitpt) (CADR vpll_pt) 0)
            sppttop (LIST (CAR splitpt) (CADR vpul_pt) 0)
      ) ;_ end of SETQ
      (SETQ vplaydef (ENTGET (TBLOBJNAME "LAYER" vplay)))
      (IF (EQ (BOOLE 1 1 (CDR (ASSOC 70 vplaydef))) 1)
        (PROGN (COMMAND ".layer" "t" vplay "")
               (IF (< (CDR (ASSOC 62 vplaydef)) 0)
                 (COMMAND ".layer" "on" vplay "")
               ) ;_ end of IF
               (ENTUPD (CDR (ASSOC -1 vpdef)))
        ) ;_ end of PROGN
        (PROGN (IF (< (CDR (ASSOC 62 vplaydef)) 0)
                 (COMMAND ".layer" "on" vplay "")
               ) ;_ end of IF
               (ENTUPD (CDR (ASSOC -1 vpdef)))
        ) ;_ end of PROGN
      ) ;_ end of IF
      (SETQ vpssname (SSNAME vpss 0))
      (SETQ allvpss (SSGET "x" '((0 . "viewport"))))
      (SETQ notvpss allvpss)
      (SETQ notvpss (SSDEL vpssname notvpss))
      (IF lblss
        (COMMAND ".stretch" "c" vpll_pt vpul_pt "r" notvpss lblss "" vpll_pt spptbot)
        (COMMAND ".stretch" "c" vpll_pt vpul_pt "r" notvpss "" vpll_pt spptbot)
      ) ;_ end of IF
      (COMMAND ".copy" vpss "" spptbot spptbot "" "")
      (IF lblss
        (COMMAND ".stretch" "c" spptbot sppttop "r" vpss allvpss lblss "" spptbot vpll_pt)
        (COMMAND ".stretch" "c" spptbot sppttop "r" vpss allvpss "" spptbot vpll_pt)
      ) ;_ end of IF
      (IF lblss
        (COMMAND ".stretch" "c" vplr_pt vpur_pt "r" vpss allvpss lblss "" vplr_pt spptbot)
        (COMMAND ".stretch" "c" vplr_pt vpur_pt "r" vpss allvpss "" vplr_pt spptbot)
      ) ;_ end of IF
      (COMMAND ".mview" "on" "all" "")
      (ENTMOD vplaydef)
      (REDRAW)
      (SETQ blknmss (SSGET "X" '((-4 . "<OR") (2 . "##ppgrid") (2 . "##spclgrid") (2 . "##spfbgrid") (-4 . "OR>"))))
      (IF blknmss
        (COND ((WCMATCH (SETQ ppgridname (STRCASE (CDR (ASSOC 2 (ENTGET (SSNAME blknmss 0)))))) "##PPGRID")
               (SETQ splitlblname (STRCAT (SUBSTR ppgridname 1 2) "ppbrklbl"))
              )
              ((WCMATCH (SETQ ppgridname (STRCASE (CDR (ASSOC 2 (ENTGET (SSNAME blknmss 0)))))) "##SPCLGRID")
               (SETQ splitlblname (STRCAT "cl" (SUBSTR ppgridname 1 2) "ppbrklbl"))
              )
              ((WCMATCH (SETQ ppgridname (STRCASE (CDR (ASSOC 2 (ENTGET (SSNAME blknmss 0)))))) "##SPFBGRID")
               (SETQ splitlblname (STRCAT "fb" (SUBSTR ppgridname 1 2) "ppbrklbl"))
              )
        ) ;_ end of COND
      ) ;_ end of IF
      (IF (AND blknmss (FINDFILE (STRCAT splitlblname ".dwg")))
        (PROGN
          (COMMAND ".insert" splitlblname spptbot 1 1 0)
          (SETQ insdef   (ENTGET (ENTLAST))
                nextdef  insdef
                attr_ls1 NIL
          ) ;_ end of SETQ
          (WHILE (AND nextdef (/= (CDR (ASSOC 0 nextdef)) "ENDBLK"))
            (IF (EQ (CDR (ASSOC 0 nextdef)) "ATTRIB")
              (SETQ attr_ls1 (APPEND attr_ls1 (LIST (LIST (CDR (ASSOC 2 nextdef)) nextdef))))
            ) ;_ end of IF
            (SETQ nextename (ENTNEXT (CDR (ASSOC -1 nextdef))))
            (IF nextename
              (SETQ nextdef (ENTGET nextename))
              (SETQ nextdef NIL)
            ) ;_ end of IF
          ) ;_ end of WHILE
          (SETQ
            ppgrident (SSGET "X" '((-4 . "<OR") (2 . "##ppgrid") (2 . "##spclgrid") (2 . "##spfbgrid") (-4 . "OR>")))
          ) ;_ end of SETQ
          (IF (AND ppgrident (EQ (SSLENGTH ppgrident) 1))
            (PROGN (SETQ nextdef2 (ENTGET (SSNAME ppgrident 0))
                         attr_ls2 NIL
                   ) ;_ end of SETQ
                   (WHILE (AND nextdef2 (/= (CDR (ASSOC 0 nextdef2)) "ENDBLK"))
                     (IF (EQ (CDR (ASSOC 0 nextdef2)) "ATTRIB")
                       (SETQ attr_ls2 (APPEND attr_ls2 (LIST (LIST (CDR (ASSOC 2 nextdef2)) nextdef2))))
                     ) ;_ end of IF
                     (SETQ nextename2 (ENTNEXT (CDR (ASSOC -1 nextdef2))))
                     (IF nextename2
                       (SETQ nextdef2 (ENTGET nextename2))
                       (SETQ nextdef2 NIL)
                     ) ;_ end of IF
                   ) ;_ end of WHILE
            ) ;_ end of PROGN
          ) ;_ end of IF
          (IF (AND attr_ls1 attr_ls2)
            (PROGN
              (FOREACH n attr_ls2
                (IF (SETQ this_lbl (ASSOC (STRCAT "M" (CAR n)) attr_ls1))
                  (PROGN
                    (SETQ new_lbl (SUBST (CONS 1 (CDR (ASSOC 1 (CADR n)))) (ASSOC 1 (CADR this_lbl)) (CADR this_lbl)))
                    (ENTMOD new_lbl)
                  ) ;_ end of PROGN
                ) ;_ end of if
              ) ;_ end of foreach
              (ENTUPD (CDR (ASSOC -1 insdef)))
            ) ;_ end of progn
          ) ;_ end of IF
        ) ;_ end of PROGN
        (PROGN (ENTMAKE (LIST (CONS 0 "LINE")
                              (CONS 8 "G-VI012SYMB")
                              (CONS 10 spptbot)
                              (CONS 11 (POLAR spptbot (* PI 0.5) 9.5))
                        ) ;_ end of LIST
               ) ;_ end of ENTMAKE
               (SETQ thislay (TBLOBJNAME "LAYER" "G-VI012SYMB"))
               (IF thislay
                 (PROGN (SETQ thislaent (ENTGET thislay)
                              thislaent (SUBST (CONS 62 2) (ASSOC 62 thislaent) thislaent)
                        ) ;_ end of SETQ
                        (ENTMOD thislaent)
                 ) ;_ end of PROGN
               ) ;_ end of IF
        ) ;_ end of PROGN
      ) ;_ end of IF
    ) ;_ end of PROGN
    (PRINC "\nProfile viewport not found! (must be on layer matching \"*VI01*NPLT*\")")
  ) ;_ end of IF
  (IF old_splitvp_error
    (SETQ *ERROR* old_splitvp_error)
  ) ;_ end of IF
  (IF old_splitvp_osmode
    (SETVAR "OSMODE" old_splitvp_osmode)
  ) ;_ end of IF
  (IF old_splitvp_attreq
    (SETVAR "ATTREQ" old_splitvp_attreq)
  ) ;_ end of IF
  (IF old_splitvp_attdia
    (SETVAR "ATTDIA" old_splitvp_attdia)
  ) ;_ end of IF
  (COMMAND ".undo" "END")
  (PRINC)
) ;_ end of DEFUN
;|«Visual LISP© Format Options»
(120 2 15 2 T "end of " 100 9 2 0 nil nil nil nil T)
;*** DO NOT add text below the comment! ***|;