;;;
;;;
;;;
;;;
;;;Scaled block insertion routine (dimscale)
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 3/14/2006
;;;>		   EDITED: 09-02-2006
;;;
(DEFUN iblk_error (msg /)
  (IF msg
    (PRINC (STRCAT "\nERROR: " msg "\nIBLK cancelled! "))
    (PRINC "\nERROR: IBLK cancelled! ")
  )
  (IF oldiblk_osmode
    (SETVAR "osmode" oldiblk_osmode)
  )
  (SETQ *ERROR* oldiblk_error)
)
(DEFUN c:iblk (/ pt1 inss1 bars)
  (SETQ oldiblk_error *ERROR*)
  (SETQ *ERROR* iblk_error)
  (SETQ oldiblk_osmode (GETVAR "osmode"))
  (SETVAR "osmode" 8)
  (IF c:mklayr NIL (LOAD "MKLAYR" "\nFile MKLAYR.LSP not loaded! "))
  (c:svlayr)
  (SETVAR "cmdecho" 0)
  (SETQ cur_vtwst (GETVAR "viewtwist"))
  (IF dimscl
    nil
    (LOAD "dimscl")
  ) ;_ end of if
  (dimscl)
  (SETQ untwang (- 0 (* (/ cur_vtwst PI) 180)))
  (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! "))
  (IF pinit
    (PROGN
      (SETQ pinit (ustr 1 "\nEnter Engineer's Initials " pinit "T"))
      (SETQ bname (STRCAT pinit "_PE"))
    ) ;_ end of progn
    (IF dpfx
      nil
      (IF bars
        nil
        (SETQ bname (ustr 0 "Block Name " bname nil))
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of if
  (SETQ cbname (STRCAT bname ".dwg"))
  (IF (OR (FINDFILE cbname) bname)
    (PROGN
      (COND
        ((OR (EQ (STRCASE bname) "WM")(WCMATCH (STRCASE bname) "W*METER"))
         (SETQ origbn bname
	       bname "WM"
	       mjrg "C"
               llt  "-"
               prod "000W"
               colr "5"
               modf "METR"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "TPED")(EQ (STRCASE bname) "TELPED")(WCMATCH (STRCASE bname) "TEL*PED*"))
         (SETQ origbn bname
	       bname "TPED"
	       mjrg "C"
               llt  "-"
               prod "0TEL"
               colr "6"
               modf "0PED"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "CABLETVPED")(EQ (STRCASE bname) "CATVPED")(EQ (STRCASE bname) "TVPED")(EQ (STRCASE bname) "CATV")(WCMATCH (STRCASE bname) "CABL*"))
         (SETQ origbn bname
	       bname "CABLETVPED"
	       mjrg "C"
               llt  "-"
               prod "CATV"
               colr "6"
               modf "0PED"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "FIBEROPTICPED")(EQ (STRCASE bname) "FOPED")(EQ (STRCASE bname) "FOP"))
         (SETQ origbn bname
	       bname "FIBEROPTICPED"
	       mjrg "C"
               llt  "-"
               prod "00FO"
               colr "6"
               modf "0PED"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "U_POLE")(EQ (STRCASE bname) "PP")(EQ (STRCASE bname) "POWERPOLE"))
         (SETQ origbn bname
	       bname "U_POLE"
               mjrg "E"
               llt  "-"
               prod "POWR"
               colr "6"
               modf "POLE"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "LUMIN")(WCMATCH (STRCASE bname) "LP")(EQ (STRCASE bname) "LIGHTPOLE")(WCMATCH (STRCASE bname) "L*POLE"))
         (SETQ origbn bname
	       bname "LUMIN"
	       mjrg "E"
               llt  "-"
               prod "LITE"
               colr "6"
               modf "POLE"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "G_POLE")(EQ (STRCASE bname) "GUYPOLE"))
         (SETQ origbn bname
	       bname "G_POLE"
	       mjrg "E"
               llt  "-"
               prod "0GUY"
               colr "6"
               modf "POLE"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "GUYWIRE")(EQ (STRCASE bname) "GW")(EQ (STRCASE bname) "GUY"))
         (SETQ origbn bname
	       bname "GUYWIRE"
	       mjrg "E"
               llt  "-"
               prod "0GUY"
               colr "6"
               modf "WIRE"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "MBOX")(EQ (STRCASE bname) "MB")(EQ (STRCASE bname) "MAILBOX"))
         (SETQ origbn bname
	       bname "MBOX"
	       mjrg "C"
               llt  "-"
               prod "MAIL"
               colr "6"
               modf "0BOX"
               usrd ""
         )
         (c:mklayr))
        ((WCMATCH (STRCASE bname) "SHRUB*")
         (SETQ origbn bname
               mjrg "C"
               llt  "-"
               prod "BUSH"
               colr "7"
               modf "SYMB"
               usrd ""
         )
         (c:mklayr))
        ((WCMATCH (STRCASE bname) "CG_T##")
         (SETQ origbn bname
               mjrg "C"
               llt  "-"
               prod "TREE"
               colr "7"
               modf "SYMB"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "I[P R]")(EQ (STRCASE bname) "EI[P R]"))
         (SETQ origbn bname
	       bname "IP"
	       mjrg "C"
               llt  "-"
               prod "IRON"
               colr "7"
               modf "0PIN"
               usrd ""
         )
         (c:mklayr))
        ((EQ (STRCASE bname) "RWMON")
         (SETQ origbn bname
	       bname "RWMON"
	       mjrg "C"
               llt  "-"
               prod "0ROW"
               colr "7"
               modf "0MON"
               usrd ""
         )
         (c:mklayr))
        ((OR (EQ (STRCASE bname) "FOMARKER")(EQ (STRCASE bname) "FO")(WCMATCH (STRCASE bname) "*SIGN*"))
          (SETQ origbn bname
		mjrg "C"
                llt  "-"
                prod "00FO"
                colr "7"
                modf "SIGN"
                usrd ""
          )
          (COND ((EQ (STRCASE bname) "RWSIGN")
                  (SETQ prod "00RW"))
                ((AND (WCMATCH (STRCASE bname) "*SIGN*")(NOT(WCMATCH (STRCASE bname) "FOSIGN")))
                  (SETQ prod "PNTS"))
          )
          (SETQ bname "SIGN1")
          (c:mklayr))
        ((WCMATCH (STRCASE bname) "*_PE")
         (SETQ origbn bname
	       mjrg "C"
               llt  "-"
               prod "ENGR"
               colr "7"
               modf "SEAL"
               usrd ""
         )
         (c:mklayr))
      )
      (SETQ pt1 (GETPOINT "\nInsertion Point "))
      (SETQ pt1 (LIST (CAR pt1) (CADR pt1) 0));(* dimsc 1001)
      (SETQ inss1 dimsc)
      (COMMAND ".insert" bname pt1 inss1 inss1 untwang)
      (IF origbn
        (SETQ bname origbn)
      )
    ) ;_ end of progn
    (PROMPT (STRCAT "\nBlock " bname " or File " cbname " not found! \n") ;_ end of STRCAT
 ;_ end of STRCAT
 ;_ end of STRCAT
 ;_ end of strcat
    ) ;_ end of prompt
  ) ;_ end of if
  (PROGN
    (SETQ pinit nil
          dpfx nil
          bars nil
    ) ;_ end of setq
  ) ;_ end of progn
  (SETVAR "cmdecho" 1)
  (c:rslayr)
  (IF oldiblk_osmode
    (SETVAR "osmode" oldiblk_osmode)
  )
  (SETQ *ERROR* oldiblk_error)
  (PRINC)
) ;_ end of DEFUN
(DEFUN c:nope ()(SETQ pinit nil)(PRINC))
(DEFUN C:WM ()(SETQ bname "WM")(C:IBLK)(PRINC))
(DEFUN C:TPED () (SETQ bname "TPED")(C:IBLK)(PRINC))
(DEFUN C:CATV () (SETQ bname "CABLETVPED")(C:IBLK)(PRINC))
(DEFUN C:FOPED () (SETQ bname "FIBEROPTICPED")(C:IBLK)(PRINC))
(DEFUN C:PP () (SETQ bname "U_POLE")(C:IBLK)(PRINC))
(DEFUN C:LP () (SETQ bname "LUMIN")(C:IBLK)(PRINC))
(DEFUN C:GP () (SETQ bname "G_POLE")(C:IBLK)(PRINC))
(DEFUN C:GW () (SETQ bname "GUYWIRE")(C:IBLK)(PRINC))
(DEFUN C:MB () (SETQ bname "MBOX")(C:IBLK)(PRINC))
(DEFUN C:IP () (SETQ bname "IP")(C:IBLK)(PRINC))
(DEFUN C:SIGN () (SETQ bname "SIGN1")(C:IBLK)(PRINC))
(DEFUN C:RWSIGN () (SETQ bname "RWSIGN")(C:IBLK)(PRINC))
(DEFUN C:RWMON () (SETQ bname "RWMON")(C:IBLK)(PRINC))
(DEFUN C:FOSIGN () (SETQ bname "FOSIGN")(C:IBLK)(PRINC))