;;;Place a user supplied block name near the end of a line. (bend part, tee, gv, bfv) ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: 8-6-2000 ;;; Edited: 11-11-2011 ;;; ;;;**************************************************************************** (DEFUN symblt_error (msg /) (PRINC (STRCAT "\nError: " msg)) (PRINC "\nSymblt aborted! ") (IF old_symblt_osmode (SETVAR "OSMODE" old_symblt_osmode) ) ;_ end of IF (SETQ *error* orig_symblt_error) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:symblt (/) ;ent end1 end2 dis1 dis2 curla ang inpt (SETQ orig_symblt_error *ERROR*) (SETQ *ERROR* symblt_error) (SETQ old_symblt_osmode (GETVAR "OSMODE")) (IF dimscl nil (LOAD "dimscl") ) ;_ end of if (dimscl) (SETQ this_layer (GETVAR "clayer")) (IF c:svlayr nil (LOAD "mklayr") ) ;_ end of if (c:svlayr) (SETVAR "osmode" 0) (IF ukword nil (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (WHILE (AND (SETQ symblt_name (ukword 0 "XBFvlt XBVlt XCpllt XCvlt XGvlt XPvlt XTeelt XRedlt XEnllt XFLglt XDOwnlt XUplt XCAplt XPLuglt XFHlt XMhlt XDIlt XYhlt XFEslt XTUlt XBOlt BFvlt BVlt Cpllt Cvlt Gvlt Pvlt Teelt Redlt Enllt FLglt DOwnlt Uplt CAplt PLuglt FHlt Yhlt Mhlt DIlt FEslt TUlt BOlt PRot Quit" "Symbol to use [BFv/BV/Cp/Cv/Gv/Pv/Tee/Red/Enl/FLg/DOwn/Up/CAp/PLug/FH/YH/Mh/DI/FEs/TU/BO/PRot/Quit] (add 'X' prefix for exist.))";XBFvlt/XBVlt/XCpllt/XCvlt/XGvlt/XPvlt/XTeelt/XRedlt/XEnllt/XFLglt/XDOwnlt/XUplt/XCAplt/XPLuglt/XFHlt/XMhlt/XDIlt/XYhlt/XFEslt/XTUlt/ symblt_name ) ;_ end of ukword ) ;_ end of setq (/= symblt_name "Quit") ) ;_ end of AND (IF (COND ((EQ symblt_name "PRot") (AND (OR (FINDFILE "inltprot.dwg") (TBLSEARCH "BLOCK" "inltprot")) (OR (FINDFILE "outlprot.dwg") (TBLSEARCH "BLOCK" "outlprot")) )) ((OR (FINDFILE (STRCAT symblt_name ".dwg")) (TBLSEARCH "BLOCK" symblt_name))T) ) (WHILE (SETQ ent (NENTSEL (STRCAT "\nSelect nearer end of line for " symblt_name) ) ;_ end of nentsel ) ;_ end of setq (COND ((EQ (CDR (ASSOC 0 (ENTGET (CAR ent)))) "LINE") (SETQ pickpt (NTH 1 ent)) (SETQ pickpt (LIST (CAR pickpt) (CADR pickpt))) (SETQ end13d (CDR (ASSOC 10 (ENTGET (CAR ent))))) (SETQ end23d (CDR (ASSOC 11 (ENTGET (CAR ent))))) (SETQ end1 (LIST (CAR end13d) (CADR end13d))) (SETQ end2 (LIST (CAR end23d) (CADR end23d))) (SETQ dis1 (DISTANCE pickpt end1)) (SETQ dis2 (DISTANCE pickpt end2)) (SETQ curla (CDR (ASSOC 8 (ENTGET (CAR ent))))) (IF (> dis1 dis2) (PROGN (SETQ ang (ANGTOS (ANGLE end2 end1) 0 4) inpt end2 ) ;_ end of setq (IF (EQ symblt_name "PRot") (COND ((>(CADDR end13d)(CADDR end23d)) (SETQ prottype "Outlprot")) ((<(CADDR end13d)(CADDR end23d)) (SETQ prottype "Inltprot")) ((=(CADDR end13d)(CADDR end23d)) (SETQ protword (ukword 1 "Outlet Inlet" "Culvert protection type? [Inlet/Outlet] " (IF protword protword "Inlet"))) (IF (EQ protword "Inlet") (SETQ prottype "Inltprot")(SETQ prottype "Outlprot"))) ) ) ) (PROGN (SETQ ang (ANGTOS (ANGLE end1 end2) 0 4) inpt end1 ) ;_ end of setq (IF (EQ symblt_name "PRot") (COND ((>(CADDR end13d)(CADDR end23d)) (SETQ prottype "Inltprot")) ((<(CADDR end13d)(CADDR end23d)) (SETQ prottype "Outlprot")) ) ) ) ) ;if (IF (AND (WCMATCH curla "*|*") (NOT (EQ symblt_name "PRot")) ) ;_ end of AND (PRINC (STRCAT "\nEntity is on Xref layer " curla ". Place symbol in the same file. " ) ;_ end of strcat ) ;_ end of princ (PROGN (IF (EQ symblt_name "PRot") nil (IF (WCMATCH (STRCASE curla) "??????2@@##P*") (PROGN (IF layentmake NIL (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ")) (layentmake (STRCAT (SUBSTR curla 1 6) "4" (SUBSTR curla 8)) "4" "continuous") (SETQ curla (STRCAT (SUBSTR curla 1 6) "4" (SUBSTR curla 8))) (SETVAR "clayer" curla) ) (SETVAR "clayer" curla) ) ) ;_ end of IF (COND ((OR (EQ symblt_name "Mhlt") (EQ symblt_name "XMhlt")) (COMMAND ".insert" symblt_name inpt (IF (>= (GETVAR "dimscale") 40) dimsc 40 ) ;_ end of IF (IF (>= (GETVAR "dimscale") 40) dimsc 40 ) ;_ end of IF ang ) ;_ end of command ) ((OR (EQ symblt_name "DIlt") (EQ symblt_name "XDIlt")) (COMMAND ".insert" symblt_name inpt (IF (>= (GETVAR "dimscale") 30) dimsc 30 ) ;_ end of IF (IF (>= (GETVAR "dimscale") 30) dimsc 30 ) ;_ end of IF ang ) ;_ end of command ) ((EQ symblt_name "PRot") (COMMAND ".-layer" "m" "C-EROC3SYMB" "c" "3" "" "") (COMMAND ".insert" prottype inpt dimsc dimsc (RTOS (* (/ (+ (* (/ (ATOF ang) 180.0) PI) PI) PI) 180.0 ) ;_ end of * 2 4 ) ;_ end of RTOS ) ;_ end of command (SETVAR "clayer" this_layer) ) (T (COMMAND ".insert" symblt_name inpt dimsc dimsc ang) ) ) ;_ end of COND ) ;_ end of progn ) ;_ end of if ) ;eq ((EQ (CDR (ASSOC 0 (ENTGET (CAR ent)))) "VERTEX") (SETQ end1 (CDR (ASSOC 10 (ENTGET (CAR ent))))) (SETQ next_ent (ENTGET (ENTNEXT (CAR ent)))) (IF (EQ (CDR (ASSOC 0 next_ent)) "VERTEX") (PROGN (SETQ end2 (CDR (ASSOC 10 next_ent))) (SETQ pickpt (NTH 1 ent)) (SETQ pickpt (LIST (CAR pickpt) (CADR pickpt))) (SETQ end1 (LIST (CAR end1) (CADR end1))) (SETQ end2 (LIST (CAR end2) (CADR end2))) (SETQ dis1 (DISTANCE pickpt end1)) (SETQ dis2 (DISTANCE pickpt end2)) (SETQ curla (CDR (ASSOC 8 (ENTGET (CAR ent))))) (IF (> dis1 dis2) (SETQ ang (ANGTOS (ANGLE end2 end1) 0 4) inpt end2 ) ;_ end of setq (SETQ ang (ANGTOS (ANGLE end1 end2) 0 4) inpt end1 ) ;_ end of setq ) ;if ) ;progn ) ;if (IF (WCMATCH curla "*|*") (PRINC (STRCAT "\nEntity is on Xref layer " curla ". Place symbol in the same file. " ) ;_ end of strcat ) ;_ end of princ (PROGN (IF (WCMATCH (STRCASE curla) "??????2@@##P*") (PROGN (IF layentmake NIL (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ")) (layentmake (STRCAT (SUBSTR curla 1 6) "4" (SUBSTR curla 8)) "4" "continuous") (SETQ curla (STRCAT (SUBSTR curla 1 6) "4" (SUBSTR curla 8))) (SETVAR "clayer" curla) ) (SETVAR "clayer" curla) ) (COND ((OR (EQ symblt_name "Mhlt") (EQ symblt_name "XMhlt")) (COMMAND ".insert" symblt_name inpt (IF (>= (GETVAR "dimscale") 40) dimsc 40 ) ;_ end of IF (IF (>= (GETVAR "dimscale") 40) dimsc 40 ) ;_ end of IF ang ) ;_ end of command ) ((OR (EQ symblt_name "DIlt") (EQ symblt_name "XDIlt")) (COMMAND ".insert" symblt_name inpt (IF (>= (GETVAR "dimscale") 30) dimsc 30 ) ;_ end of IF (IF (>= (GETVAR "dimscale") 30) dimsc 30 ) ;_ end of IF ang ) ;_ end of command ) ((EQ symblt_name "PRot") (IF ukword NIL (load "ukword" "\nFile UKWORD.LSP not loaded! ")) (SETQ inoroutprot (ukword 1 "Inlet Outlet" "Type of protection? [Inlet/Outlet] " (IF inoroutprot inoroutprot "Outlet"))) (IF (EQ inoroutprot "Inlet") (SETQ symblt_name "inltprot") (SETQ symblt_name "Outlprot") ) (COMMAND ".-layer" "m" "C-EROC3SYMB" "c" "3" "" "") (COMMAND ".insert" symblt_name inpt dimsc dimsc (RTOS (* (/ (+ (* (/ (ATOF ang) 180.0) PI) PI) PI) 180.0 ) ;_ end of * 2 4 ) ;_ end of RTOS ) ;_ end of command (SETVAR "clayer" this_layer) ) (T (COMMAND ".insert" symblt_name inpt dimsc dimsc ang) ) ) ;_ end of COND ) ;_ end of progn ) ;_ end of if ) ;eq (T (PRINC (CDR (ASSOC 0 (ENTGET (CAR ent)))))) ) ;_ end of cond ) ;while (IF (EQ symblt_name "PRot") (PRINC (STRCAT "\nSymbol (block or file) inltprot and/or outlprot not found! ")) (PRINC (STRCAT "\nSymbol (block or file) " symblt_name " not found! ")) ) ) ;_ end of if ) ;_ end of WHILE (SETVAR "osmode" old_symblt_osmode) (SETQ *ERROR* orig_symblt_error) (c:rslayr) (PRINC) ) ;defun ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 1 0 nil T nil T) ;*** DO NOT add text below the comment! ***|;