;;; ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: ;;; Edited: ;;;**************************************************************************** (DEFUN hatdrv_error (msg /) (PRINC (STRCAT "\nError: " msg ": " (IF debug_funs (STRCAT (IF oldfunname4 (STRCAT oldfunname4 "; ") "") (IF oldfunname3 (STRCAT oldfunname3 "; ") "") (IF oldfunname2 (STRCAT oldfunname2 "; ") "") (IF oldfunname1 (STRCAT oldfunname1 "; ") "") (IF oldfunname0 (STRCAT oldfunname0 "; ") "") (IF funname funname "") ) "" ) ) ) (SETVAR "osmode" orig_hatdrv_osmode) (SETQ *error* orig_hatdrverror) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:hatdrv (/ gotpoint) (SETQ oldfunname4 NIL oldfunname3 NIL oldfunname2 NIL oldfunname1 NIL oldfunname0 NIL funname "c:hatdrv") (SETQ orig_hatdrverror *error* *error* hatdrv_error orig_hatdrv_osmode (GETVAR "osmode") ) ;_ end of SETQ (SETVAR "OSMODE" 1541) (if ukword NIL (load "ukword" "\nFile UKWORD.LSP not loaded! ")) (if dimscl NIL (load "dimscl" "\nFile DIMSCL.LSP not loaded! ")) (dimscl) (SETQ this_drive_type (ukword 1 "Road Drive Curb Swale Walkway" "\nType [Road/Drive/Curb/Swale/Walkway]" (IF this_drive_type this_drive_type "Drive" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (SETQ this_drive_matl (ukword 1 "Asphalt Brick Concrete Gravel Soil Dirt" "\nType of pavement [Asphalt/Brick/Concrete/Gravel/Soil/Dirt]" (IF this_drive_matl this_drive_matl "Gravel" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (COND ((WCMATCH (STRCASE this_drive_matl) "ASPHALT") (SETQ ent_lay "C-ASPH")) ((WCMATCH (STRCASE this_drive_matl) "BRICK") (SETQ ent_lay "C-ASPH")) ((WCMATCH (STRCASE this_drive_matl) "CONCRETE") (SETQ ent_lay "C-CONC")) ((WCMATCH (STRCASE this_drive_matl) "GRAVEL") (SETQ ent_lay "C-GRAV")) ((WCMATCH (STRCASE this_drive_matl) "SOIL") (SETQ ent_lay "C-SOIL")) ((WCMATCH (STRCASE this_drive_matl) "DIRT") (SETQ ent_lay "C-SOIL")) ) ;_ end of COND (COND ((EQ (STRCASE this_drive_type) "ROAD") (SETQ ent_lay (STRCAT ent_lay "6ROAD"))) ((EQ (STRCASE this_drive_type) "DRIVE") (SETQ ent_lay (STRCAT ent_lay "7DRVE"))) ((EQ (STRCASE this_drive_type) "CURB") (SETQ ent_lay (STRCAT ent_lay "7CURB"))) ((EQ (STRCASE this_drive_type) "SWALE") (SETQ ent_lay (STRCAT ent_lay "7SWLE"))) ((EQ (STRCASE this_drive_type) "WALKWAY") (SETQ ent_lay (STRCAT ent_lay "7WALK"))) ) (IF layentmake nil (LOAD "MKLAYR" "\nFile MKLAYER.LSP not loaded! ") ) ;_ end of IF (layentmake (STRCAT (SUBSTR ent_lay 1 6) "WPATT") "252" "CONTINUOUS") (IF (>= (atoi (getvar "acadver")) 18) (COMMAND "-bhatch" "A" "R" "Y" "" "P" "ansi31" 5 0 (SETQ gotpoint (GETPOINT "Select Point")) "") (COMMAND "-bhatch" "A" "R" "N" "" "P" "ansi31" 5 0 (SETQ gotpoint (GETPOINT "Select Point")) "") ) (IF gotpoint (PROGN (layentmake ent_lay (SUBSTR ent_lay 7 1) "CONTINUOUS") (IF c:hatbnd nil (LOAD "HATBND" "\nFile HATBND.LSP not loaded! ") ) ;_ end of IF (c:hatbnd) (IF c:procp nil (LOAD "PROCP" "\nFile PROCP.LSP not loaded! ") ) ;_ end of IF (SETQ from_hatdrv T) (c:sgr) (c:procp) (c:sgr) (SETQ from_hatdrv NIL) ;;; (COMMAND "ERASE") ) ;_ end of PROGN ) ;_ end of IF (SETQ *error* orig_hatdrverror) (SETVAR "osmode" orig_hatdrv_osmode) (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN C:DRVBND () (VL-LOAD-COM) (SETQ this-ename (CAR (ENTSEL "\nSelect Profile hatch boundary (AcDb2DPolyline Object): " ) ;_ end of ENTSEL ) ;_ end of CAR ) ;_ end of SETQ (SETQ this-object (VLAX-ENAME->VLA-OBJECT this-ename)) (SETQ this-obj-name (VLAX-GET this-object 'ObjectName)) (IF (EQ this-obj-name "AcDb2dPolyline") (PROGN (SETQ coords (VLAX-GET this-object 'Coordinates)) (setq cnt 2 coord_lst NIL ) (WHILE (< cnt (LENGTH coords)) (SETQ coord_lst (APPEND coord_lst (LIST (LIST (NTH (- cnt 2) coords)(NTH (- cnt 1) coords)(NTH cnt coords)))) cnt (+ cnt 3) ) ) (SETQ min-x (EVAL (CONS 'MIN (MAPCAR 'CAR coord_lst)))) (SETQ max-x (EVAL (CONS 'MAX (MAPCAR 'CAR coord_lst)))) (SETQ min-y (EVAL (CONS 'MIN (MAPCAR 'CADR coord_lst)))) (SETQ max-y (EVAL (CONS 'MAX (MAPCAR 'CADR coord_lst)))) (ENTMAKE (LIST (CONS 0 "LINE") (CONS 100 "AcDbEntity") (CONS 8 "0") (CONS 100 "AcDbLine") (CONS 10 (LIST min-x (- min-y 15) 0.0)) (CONS 11 (LIST min-x (+ max-y 15) 0.0)) (CONS 410 "Model") ) ) (ENTMAKE (LIST (CONS 0 "LINE") (CONS 100 "AcDbEntity") (CONS 8 "0") (CONS 100 "AcDbLine") (CONS 10 (LIST max-x (- min-y 15) 0.0)) (CONS 11 (LIST max-x (+ max-y 15) 0.0)) (CONS 410 "Model") ) ) ) (ALERT (STRCAT this-obj-name " object selected, try again.")) ) ) ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 1 nil nil nil nil T) ;*** DO NOT add text below the comment! ***|;