;;;Creates driveways as polylines in the drawing using selected AECC_POINT objects, ;;;AECC_COGO_POINT objects, DCA POINT blocks, or picked points. ;;;A licensed version of AutoCAD Civil is required to make use of AECC objects. ;;;If the point descriptions are discernable for type and width these values ;;;are set automatically; otherwise, you will be asked to specify type and/or ;;;width. Type is incorporated into the CLG layer name which is automatically ;;;generated. If an edge of pavement line is available, the driveway centerline ;;;point at the EOP and a 'nearest' snapped point to the EOP on each side of the ;;;driveway will define the lines to which the driveway lines are intersected. ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; All rights reserved. ;;; ;;; Copyright: 12/15/2004 ;;; Edited: 12/15/2016 ;;; ;;; Revised to loop until Quit ;;; ;;; Requires BULGEBYPNTS.LSP UANGLE.LSP UDIST.LSP UPOINT.LSP UKWORD.LSP UINT.LSP UREAL.LSP USTR.LSP ;;; MAKE_LAYER_ENT.LSP ;;; ;;;**************************************************************************** (DEFUN driveway_error (msg / eop_point) (IF old_drvwosmode (SETVAR "osmode" old_drvwosmode) ) ;_ end of IF (SETQ *error* (IF old_drvwerror old_drvwerror NIL ) ;_ end of IF ) ;_ end of SETQ (SETQ dotanarcs_set NIL ent_10x NIL ent_10y NIL ent_10z NIL ent_11x NIL ent_11y NIL ent_11z NIL drvbp1 NIL drvbp2 NIL ) ;_ end of SETQ (PRINC "\n") (PRINC msg) (PRINC " May need UNDO END. ") (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN c:driveway (/ line_ent ent_data ent_pt el_adj_val el_adj_val1 el_adj_val2 defadjcnt ;;; drvbp1 ;;; drvbp2 eop_point drv_point drv_point_lst pick_302 ent_302 ent_303 nent_302 nent_303 ent_data nentdata ent_10x ent_10y ent_10z ;;; ent_10 nent_10x nent_10y nent_10z ;;; nent_10 drv_size1_pt1 drv_size1_pt2 drv_size2_pt1 drv_size2_pt2 ) (IF debug_pads ;indents debug text upon entering this function (IF (> (STRLEN debug_pads) 15) (SETQ debug_pads (SUBSTR debug_pads 1 15)) (SETQ debug_pads (STRCAT debug_pads "\t")) ) ;_ end of IF (SETQ debug_pads "\t") ) ;_ end of IF (IF pttxt NIL (LOAD "pttxt" "\nFile PTTXT.LSP not loaded! ") ) ;_ end of IF (COMMAND ".undo" "begin") (IF uangle NIL (LOAD "uangle" "\nFile UANGLE.LSP not loaded!") ) ;_ end of IF (IF udist NIL (LOAD "udist" "\nFile UDIST.LSP not loaded!") ) ;_ end of IF (IF upoint NIL (LOAD "upoint" "\nFile UPOINT.LSP not loaded!") ) ;_ end of IF (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded!") ) ;_ end of IF (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded!") ) ;_ end of IF (IF ureal NIL (LOAD "ureal" "\nFile UREAL.LSP not loaded!") ) ;_ end of IF (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded!") ) ;_ end of IF (SETQ old_drvw_snapang (GETVAR "SNAPANG")) (SETQ old_drvwosmode (GETVAR "osmode")) (SETVAR "osmode" 9) (SETQ old_drvwerror *error*) (SETQ *error* driveway_error) (SETQ drvw-done NIL) (WHILE (NOT drvw-done) (SETQ line_ent (NENTSEL (STRCAT "\nSelect road or driveway center AECC object or point block at EOP: "))) (SETQ lnsel_type "Select") (IF line_ent NIL (WHILE (AND (NOT line_ent) (EQ lnsel_type "Select")) (IF debug_drvw (IF line_ent (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: Got EOP point" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: Did NOT get EOP point" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (SETQ lnsel_type (ukword 1 "Select Pick Quit" "No AECC object or point block selected! [Select AECC object/or Pick a point/Quit]" "Select" ) ;_ end of ukword ) ;_ end of SETQ (COND ((EQ lnsel_type "Select") (SETQ line_ent (NENTSEL "\nSelect road or driveway center AECC object or point block at EOP: ")) (IF line_ent (SETQ lnsel_type NIL) ) ;_ end of IF ) ((EQ lnsel_type "Quit") (SETQ drvw-done T)) ) ;_ end of COND ) ;_ end of WHILE ) ;_ end of IF (IF (NOT drvw-done) (PROGN (IF (AND line_ent (OR (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "AECC_POINT") (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "AECC_COGO_POINT") (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "INSERT") (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "ATTRIB") ) ;_ end of OR ) ;_ end of AND (PROGN (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: (IF (AND line_ent... (OR AECC_POINT, AECC_COGO_POINT, INSERT, ATTRIB)" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (COND ((EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "AECC_POINT") (SETQ ent_data (ENTGET (CAR line_ent)))) ((EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "AECC_COGO_POINT") (IF (AND aeccapp aeccdoc aeccdb (EQ (VLAX-GET-PROPERTY aeccdoc "FullName") (VLAX-GET-PROPERTY (VLAX-GET-PROPERTY aeccapp "ActiveDocument") "FullName") ) ;_ end of EQ ) ;_ end of AND NIL (PROGN (IF (AND aeccapp aeccdoc aeccdb) NIL (VL-LOAD-COM) ) ;_ end of IF (IF c3difodoc NIL (LOAD "c3difodoc" "\nFile C3DIFODOC not loaded! ") ) ;_ end of IF (c3difodoc) (SETQ aeccdoc (VLAX-GET-PROPERTY aeccapp "ActiveDocument")) (SETQ aeccdb (VLAX-GET-PROPERTY aeccdoc "Database")) ) ;_ end of PROGN ) ;_ end of IF (SETQ cogopt (VLAX-ENAME->VLA-OBJECT (CAR line_ent)) ent_302 (VLAX-GET-PROPERTY cogopt "Description") ;description ent_303 (VLAX-GET-PROPERTY cogopt "FullDescription") ;full description ent_10x (VLAX-GET-PROPERTY cogopt "Easting") ent_10y (VLAX-GET-PROPERTY cogopt "Northing") ent_10z (VLAX-GET-PROPERTY cogopt "Elevation") ent_data NIL ent_10 (LIST ent_10x ent_10y ent_10z) ) ;_ end of SETQ ) ((OR (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "INSERT") (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "ATTRIB") ) ;_ end of OR (SETQ this_ent (ENTGET (CAR line_ent))) (WHILE (NOT (EQ (CDR (ASSOC 0 (SETQ this_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_ent))))))) "SEQEND")) ) ;_ end of WHILE (SETQ this_ent (ENTGET (CDR (ASSOC -2 this_ent))) eop_point (CDR (ASSOC 10 this_ent)) eop_point_lst (APPEND eop_point_lst (LIST eop_point)) ) ;_ end of SETQ (WHILE (NOT (EQ (CDR (ASSOC 0 (SETQ this_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_ent))))))) "SEQEND")) (IF (EQ (STRCASE (CDR (ASSOC 2 this_ent))) "DESC") (SETQ pick_302 (CDR (ASSOC 1 this_ent))) ) ;_ end of IF ) ;_ end of WHILE (SETQ ent_data (LIST (CONS 0 "AECC_POINT") (CONS 11 eop_point) (CONS 302 pick_302) (CONS 303 pick_302))) ) ) ;_ end of COND (SETQ pick_302 NIL) ) ;_ end of PROGN (PROGN (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: (IF (NOT (AND line_ent...)) Doing else (PROGN...)." ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "osmode" 512) (SETQ eop_point (upoint 1 "Quit" "\nPick point at edge of roadway or [Quit]" nil nil)) (SETQ eop_point_lst (APPEND eop_point_lst (LIST eop_point))) (COND ((EQ eop_point "Quit") (SETQ drvw-done T)) (T (SETQ pick_302 (ukword 1 "Asphalt Concrete Gravel Soil" "\nType of driveway [Asphalt/Concrete/Gravel/Soil]" (IF pick_302 pick_302 (IF this_drive_matl this_drive_matl "Gravel" ) ;_ end of IF ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (SETQ this_drive_matl pick_302) (SETQ ent_data (LIST (CONS 0 "AECC_POINT") (CONS 11 eop_point) (CONS 302 pick_302) (CONS 303 pick_302))) ) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF (IF (AND (NOT drvw-done) (OR (NOT line_ent) (NOT (EQ (CDR (ASSOC 0 (ENTGET (CAR line_ent)))) "AECC_COGO_POINT"))) ent_data ) ;_ end of AND (PROGN (SETQ ent_10x (CADR (ASSOC 11 ent_data))) (SETQ ent_10y (CADDR (ASSOC 11 ent_data))) (SETQ ent_10z (CADDDR (ASSOC 11 ent_data))) (SETQ ent_10 (LIST ent_10x ent_10y ent_10z)) (SETQ ent_302 (STRCASE (CDR (ASSOC 302 ent_data)))) (SETQ ent_303 (STRCASE (CDR (ASSOC 303 ent_data)))) (SETQ drvbp1 (LIST ent_10x ent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF " ent_data = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC ent_data) (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF " ent_10x = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC ent_10x) (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF " ent_10y = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC ent_10y) (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF " ent_302 = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC ent_302) (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF " ent_303 = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC ent_303) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (IF (OR drvw-done (NOT ent_302)) (COND (drvw-done NIL) ((NOT ent_302) (ALERT "Could not determine type.")) ) ;_ end of COND (PROGN (SETQ el_adj_val 0) (SETQ this_ent_302 ent_302) (IF (WCMATCH ent_302 "*#*") NIL (PROGN (SETQ drv_size1 (ureal 1 "Pick" "Width of drive? [Pick]" (IF drv_size1 drv_size1 10.0 ) ;_ end of if ) ;_ end of uint ) ;_ end of SETQ (IF (EQ drv_size1 "Pick") (PROGN (SETQ drv_size1_pt1 (upoint 1 "" "Pick 1st width point" nil nil)) (SETQ drv_size1_pt2 (upoint 1 "" "Pick 2nd width point" nil drv_size1_pt1)) (SETQ drv_size1 (DISTANCE (REVERSE (CDR (REVERSE drv_size1_pt1))) (REVERSE (CDR (REVERSE drv_size1_pt2))) ) ;_ end of DISTANCE ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (COND ((OR (WCMATCH (STRCASE ent_302) "*ASP*R*D*") (WCMATCH (STRCASE ent_302) "*#AR") (WCMATCH (STRCASE ent_302) "*#'AR") (WCMATCH (STRCASE ent_302) "*#ARD") (WCMATCH (STRCASE ent_302) "*#'ARD") (WCMATCH (STRCASE ent_302) "*# AR") (WCMATCH (STRCASE ent_302) "*# A-RD") (WCMATCH (STRCASE ent_302) "*#' AR") (WCMATCH (STRCASE ent_302) "*# ARD") (WCMATCH (STRCASE ent_302) "*#' ARD") (WCMATCH (STRCASE ent_302) "*#AR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'AR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#ARD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'ARD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# AR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' AR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# ARD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' ARD[/@&+E][EPO]*") ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 1) "' ASPHALT ROAD")) ) ((OR (WCMATCH (STRCASE ent_302) "*ASP*D*R*") (WCMATCH (STRCASE ent_302) "*#AD") (WCMATCH (STRCASE ent_302) "*#'AD") (WCMATCH (STRCASE ent_302) "*#ADR") (WCMATCH (STRCASE ent_302) "*#'ADR") (WCMATCH (STRCASE ent_302) "*# AD") (WCMATCH (STRCASE ent_302) "*# A-DR") (WCMATCH (STRCASE ent_302) "*#' AD") (WCMATCH (STRCASE ent_302) "*# ADR") (WCMATCH (STRCASE ent_302) "*#' ADR") (WCMATCH (STRCASE ent_302) "*#AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#ADR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'ADR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# ADR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' ADR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*ASPH*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 1) "' ASPHALT DRIVE")) ) ((OR (WCMATCH (STRCASE ent_302) "*GRV*DR*") (WCMATCH (STRCASE ent_302) "*GRAVEL*DR*") (WCMATCH (STRCASE ent_302) "*GRDR*") (WCMATCH (STRCASE ent_302) "*#GD") (WCMATCH (STRCASE ent_302) "*#'GD") (WCMATCH (STRCASE ent_302) "*#GDR") (WCMATCH (STRCASE ent_302) "*#'GDR") (WCMATCH (STRCASE ent_302) "*# GD") (WCMATCH (STRCASE ent_302) "*# G-DR") (WCMATCH (STRCASE ent_302) "*#' GD") (WCMATCH (STRCASE ent_302) "*# GDR") (WCMATCH (STRCASE ent_302) "*#' GDR") (WCMATCH (STRCASE ent_302) "*#GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#GDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'GDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# GDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' GDR[/@&+E][EPO]*") (AND (WCMATCH (STRCASE ent_302) "*GR*") (NOT (WCMATCH (STRCASE ent_302) "*R*D*"))) (IF pick_302 (WCMATCH (STRCASE pick_302) "*GRAV*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 0) "' GRAVEL DRIVE")) ) ((OR (WCMATCH (STRCASE ent_302) "*GRV*R*D*") (WCMATCH (STRCASE ent_302) "*GRAVEL*R*D*") (WCMATCH (STRCASE ent_302) "*GRRD*") (WCMATCH (STRCASE ent_302) "*#GR") (WCMATCH (STRCASE ent_302) "*#'GR") (WCMATCH (STRCASE ent_302) "*#GRD") (WCMATCH (STRCASE ent_302) "*#'GRD") (WCMATCH (STRCASE ent_302) "*# GR") (WCMATCH (STRCASE ent_302) "*# G-RD") (WCMATCH (STRCASE ent_302) "*#' GR") (WCMATCH (STRCASE ent_302) "*# GRD") (WCMATCH (STRCASE ent_302) "*#' GRD") (WCMATCH (STRCASE ent_302) "*#GR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'GR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#GRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'GRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# GR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' GR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# GRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' GRD[/@&+E][EPO]*") ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 0) "' GRAVEL ROAD")) ) ((OR (WCMATCH (STRCASE ent_302) "*CONC*DR*") (WCMATCH (STRCASE ent_302) "*#CD") (WCMATCH (STRCASE ent_302) "*#'CD") (WCMATCH (STRCASE ent_302) "*#CDR") (WCMATCH (STRCASE ent_302) "*#'CDR") (WCMATCH (STRCASE ent_302) "*# CD") (WCMATCH (STRCASE ent_302) "*# C-DR") (WCMATCH (STRCASE ent_302) "*#' CD") (WCMATCH (STRCASE ent_302) "*# CDR") (WCMATCH (STRCASE ent_302) "*#' CDR") (WCMATCH (STRCASE ent_302) "*#CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#CDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'CDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# CDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' CDR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*CONC*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 0) "' CONCRETE DRIVE")) ) ((OR (WCMATCH (STRCASE ent_302) "*CONC*R*D") (WCMATCH (STRCASE ent_302) "*#CR") (WCMATCH (STRCASE ent_302) "*#'CR") (WCMATCH (STRCASE ent_302) "*#CRD") (WCMATCH (STRCASE ent_302) "*#'CRD") (WCMATCH (STRCASE ent_302) "*# CR") (WCMATCH (STRCASE ent_302) "*# C-RD") (WCMATCH (STRCASE ent_302) "*#' CR") (WCMATCH (STRCASE ent_302) "*# CRD") (WCMATCH (STRCASE ent_302) "*#' CRD") (WCMATCH (STRCASE ent_302) "*#CR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'CR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#CRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'CRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# CR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' CR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# CRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' CRD[/@&+E][EPO]*") ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 0) "' CONCRETE ROAD")) ) ((OR (WCMATCH (STRCASE ent_302) "*SOIL*R*D*") (WCMATCH (STRCASE ent_302) "*#SR") (WCMATCH (STRCASE ent_302) "*#'SR") (WCMATCH (STRCASE ent_302) "*#SRD") (WCMATCH (STRCASE ent_302) "*#'SRD") (WCMATCH (STRCASE ent_302) "*# SR") (WCMATCH (STRCASE ent_302) "*# S-RD") (WCMATCH (STRCASE ent_302) "*#' SR") (WCMATCH (STRCASE ent_302) "*# SRD") (WCMATCH (STRCASE ent_302) "*#' SRD") (WCMATCH (STRCASE ent_302) "*#SR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'SR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#SRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'SRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# SR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' SR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# SRD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' SRD[/@&+E][EPO]*") ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 1) "' SOIL ROAD")) ) ((OR (WCMATCH (STRCASE ent_302) "*SOIL*") (WCMATCH (STRCASE ent_302) "*#SD") (WCMATCH (STRCASE ent_302) "*#'SD") (WCMATCH (STRCASE ent_302) "*#SDR") (WCMATCH (STRCASE ent_302) "*#'SDR") (WCMATCH (STRCASE ent_302) "*# SD") (WCMATCH (STRCASE ent_302) "*# S-DR") (WCMATCH (STRCASE ent_302) "*#' SD") (WCMATCH (STRCASE ent_302) "*# SDR") (WCMATCH (STRCASE ent_302) "*#' SDR") (WCMATCH (STRCASE ent_302) "*#SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#SDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'SDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# SDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' SDR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*SOIL*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 1) "' SOIL DRIVE")) ) (T (SETQ pick_302 (ukword 1 "Asphalt Concrete Gravel Soil" "\nType of driveway [Asphalt/Concrete/Gravel/Soil]" (IF pick_302 pick_302 (IF this_drive_matl this_drive_matl "Gravel" ) ;_ end of IF ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (SETQ this_drive_matl pick_302) (SETQ ent_302 (STRCAT "CL" (RTOS drv_size1 2 1) "' " (STRCASE pick_302) " DRIVE")) ) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF (COND ((AND (NOT (WCMATCH ent_302 "*#*@@*")) ;CL (OR (WCMATCH ent_302 "*@@#*") ;CL (WCMATCH ent_302 "*@@`'#*") ;CL (WCMATCH ent_302 "*@@##*") ;CL (WCMATCH ent_302 "*@@ #*") ;CL (WCMATCH ent_302 "*@@-#*") ;CL (WCMATCH ent_302 "*@@#F*") ;CL (WCMATCH ent_302 "*@@##F*") ;CL ) ;_ end of or ) ;_ end of AND (PRINC (STRCAT " " ent_302 " ")) (PRINC) (SETQ defadjcnt 1) (WHILE (OR (WCMATCH (SUBSTR ent_302 defadjcnt) "*@@#*") ;CL (WCMATCH (SUBSTR ent_302 defadjcnt) "*@@ #*") ;CL (WCMATCH (SUBSTR ent_302 defadjcnt) "*@@-#*") ;CL ) ;_ end of OR (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #1A " (SUBSTR ent_302 defadjcnt) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ def_adj_val1 (SUBSTR ent_302 (1+ defadjcnt))) (SETQ defadjcnt1 1) (WHILE (OR (WCMATCH (SUBSTR def_adj_val1 defadjcnt1) "*#*") (WCMATCH (SUBSTR def_adj_val1 defadjcnt1) "*#F*") ) ;_ end of OR (SETQ defadjcnt1 (1+ defadjcnt1)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #1B " (SUBSTR def_adj_val1 defadjcnt1) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (SETQ drvp1d (ABS (/ (READ (SUBSTR def_adj_val1 1 (1- defadjcnt1))) 2.0))) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1(A) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ drvbp1 (LIST ent_10x ent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1(B) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ((WCMATCH ent_302 "*#*CL*") ;CL (PRINC (STRCAT " " ent_302 " ")) (PRINC) (SETQ defadjcnt 1) (WHILE (NOT (WCMATCH (SUBSTR ent_302 defadjcnt) "#*CL*")) ;CL (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #1C " (SUBSTR ent_302 defadjcnt) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ drvp1d (ABS (/ (READ (SUBSTR ent_302 defadjcnt)) 2.0))) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1(A) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ drvbp1 (LIST ent_10x ent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1(B) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) (T (PRINC (STRCAT " " ent_302 " ")) (PRINC) (SETQ defadjcnt 1) (WHILE (AND (WCMATCH (SUBSTR ent_302 defadjcnt) "*#*") (NOT (WCMATCH (SUBSTR ent_302 defadjcnt) "#*"))) (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #1C " (SUBSTR ent_302 defadjcnt) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ def_adj_val1 (SUBSTR ent_302 defadjcnt)) (SETQ defadjcnt 1) (WHILE (WCMATCH (SUBSTR def_adj_val1 defadjcnt) "*#*") (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #1D " (SUBSTR def_adj_val1 defadjcnt) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (SETQ drvp1d (ABS (/ (READ (SUBSTR def_adj_val1 1 (1- defadjcnt))) 2.0))) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1(A) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ drvbp1 (LIST ent_10x ent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1(B) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of cond (SETQ next_pnt NIL) (SETQ next_pnt (NENTSEL "\nSelect 1st road or driveway AECC_POINT away from road: ")) (SETQ ptsel_type "Select") (IF next_pnt NIL (WHILE (AND (NOT next_pnt) (EQ ptsel_type "Select")) (IF debug_drvw (IF next_pnt (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: Got next point" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: Did NOT get next point" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (SETQ ptsel_type (ukword 1 "Select Pick" "No AECC object or point block selected! [Select AECC object/or Pick a point]" "Select" ) ;_ end of ukword ) ;_ end of SETQ (COND ((EQ ptsel_type "Select") (SETQ next_pnt (NENTSEL "\nSelect 1st road or driveway AECC_POINT away from road: ")) (IF next_pnt (SETQ ptsel_type NIL) ) ;_ end of IF ) ) ;_ end of COND ) ;_ end of WHILE ) ;_ end of IF (IF (AND next_pnt (OR (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "AECC_POINT") (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "AECC_COGO_POINT") (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "INSERT") (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "ATTRIB") ) ;_ end of OR ) ;_ end of AND (PROGN (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: Passed AECC_POINT/Block test" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (COND ((EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "AECC_POINT") (SETQ nent_data (ENTGET (CAR next_pnt)) drv_point NIL cogopt NIL nent_302 NIL nent_303 NIL nent_10x NIL nent_10y NIL nent_10z NIL ) ;_ end of SETQ ) ((EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "AECC_COGO_POINT") (IF (AND aeccapp aeccdoc aeccdb (EQ (VLAX-GET-PROPERTY aeccdoc "FullName") (VLAX-GET-PROPERTY (VLAX-GET-PROPERTY aeccapp "ActiveDocument") "FullName") ) ;_ end of EQ ) ;_ end of AND NIL (PROGN (IF (AND aeccapp aeccdoc aeccdb) NIL (VL-LOAD-COM) ) ;_ end of IF (IF c3difodoc NIL (LOAD "c3difodoc" "\nFile C3DIFODOC not loaded! ") ) ;_ end of IF (c3difodoc) (SETQ aeccdoc (VLAX-GET-PROPERTY aeccapp "ActiveDocument")) (SETQ aeccdb (VLAX-GET-PROPERTY aeccdoc "Database")) ) ;_ end of PROGN ) ;_ end of IF (SETQ cogopt (VLAX-ENAME->VLA-OBJECT (CAR next_pnt)) nent_302 (VLAX-GET-PROPERTY cogopt "Description") ;description nent_303 (VLAX-GET-PROPERTY cogopt "FullDescription") ;full description nent_10x (VLAX-GET-PROPERTY cogopt "Easting") nent_10y (VLAX-GET-PROPERTY cogopt "Northing") nent_10z (VLAX-GET-PROPERTY cogopt "Elevation") nent_10 (LIST nent_10x nent_10y nent_10z) drv_point NIL nent_data NIL ) ;_ end of SETQ ) ((OR (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "INSERT") (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "ATTRIB") ) ;_ end of OR (SETQ this_ent (ENTGET (CAR next_pnt))) (WHILE (NOT (EQ (CDR (ASSOC 0 (SETQ this_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_ent))))))) "SEQEND")) ) ;_ end of WHILE (SETQ this_ent (ENTGET (CDR (ASSOC -2 this_ent))) drv_point (CDR (ASSOC 10 this_ent)) drv_point_lst (APPEND drv_point_lst (LIST drv_point)) cogopt NIL nent_302 NIL nent_303 NIL nent_10x NIL nent_10y NIL nent_10z NIL ) ;_ end of SETQ (WHILE (NOT (EQ (CDR (ASSOC 0 (SETQ this_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_ent))))))) "SEQEND")) (IF (EQ (STRCASE (CDR (ASSOC 2 this_ent))) "DESC") (SETQ pick_302 (CDR (ASSOC 1 this_ent))) ) ;_ end of IF ) ;_ end of WHILE (SETQ nent_data (LIST (CONS 0 "AECC_POINT") (CONS 11 drv_point) (CONS 302 pick_302) (CONS 303 pick_302)) ) ;_ end of SETQ ) ) ;_ end of COND (COND ((AND nent_10x nent_10y) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: (COND ((AND nent_10x nent_10y)...))" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "osmode" 1032) (SETQ drv_point2 (upoint 1 "" "\nSelect road or driveway center point of continuation away from road" nil (LIST nent_10x nent_10y) ) ;_ end of upoint ) ;_ end of SETQ ) (drv_point (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: (COND (drv_point ...))" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "osmode" 1032) (SETQ drv_point2 (upoint 1 "" "\nSelect road or driveway center point of continuation away from road" nil drv_point ) ;_ end of upoint ) ;_ end of SETQ ) (T (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: (COND (T ...))" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ drv_point2 NIL) ) ) ;_ end of COND (IF drv_point2 (PROGN (IF (SETQ drv_point2_ss (SSGET "CP" (LIST (POLAR drv_point2 0 0.001) (POLAR drv_point2 (* PI 0.5) 0.001) (POLAR drv_point2 PI 0.001) (POLAR drv_point2 (* PI 1.5) 0.001) ) ;_ end of LIST '((0 . "AECC_COGO_POINT,AECC_POINT")) ) ;_ end of SSGET ) ;_ end of SETQ (PROGN (COND ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME drv_point2_ss 0)))) "AECC_POINT") (SETQ nent2_data (ENTGET (SSNAME drv_point2_ss 0)) drv_point NIL cogopt2 NIL nent2_302 NIL nent2_303 NIL nent2_10x NIL nent2_10y NIL nent2_10z NIL ) ;_ end of SETQ ) ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME drv_point2_ss 0)))) "AECC_COGO_POINT") (IF (AND aeccapp aeccdoc aeccdb (EQ (VLAX-GET-PROPERTY aeccdoc "FullName") (VLAX-GET-PROPERTY (VLAX-GET-PROPERTY aeccapp "ActiveDocument") "FullName") ) ;_ end of EQ ) ;_ end of AND NIL (PROGN (IF (AND aeccapp aeccdoc aeccdb) NIL (VL-LOAD-COM) ) ;_ end of IF (IF c3difodoc NIL (LOAD "c3difodoc" "\nFile C3DIFODOC not loaded! ") ) ;_ end of IF (c3difodoc) (SETQ aeccdoc (VLAX-GET-PROPERTY aeccapp "ActiveDocument")) (SETQ aeccdb (VLAX-GET-PROPERTY aeccdoc "Database")) ) ;_ end of PROGN ) ;_ end of IF (SETQ cogopt2 (VLAX-ENAME->VLA-OBJECT (SSNAME drv_point2_ss 0)) nent2_302 (VLAX-GET-PROPERTY cogopt2 "Description") ;description nent2_303 (VLAX-GET-PROPERTY cogopt2 "FullDescription") ;full description nent2_10x (VLAX-GET-PROPERTY cogopt2 "Easting") nent2_10y (VLAX-GET-PROPERTY cogopt2 "Northing") nent2_10z (VLAX-GET-PROPERTY cogopt2 "Elevation") nent2_10 (LIST nent2_10x nent2_10y nent2_10z) cogopt2 NIL drv_point NIL nent_data NIL drv_point2_ss NIL ) ;_ end of SETQ ) ) ;_ end of COND (IF (AND nent_302 nent2_302 (EQ (TYPE nent_302) 'STR) (EQ (TYPE nent2_302) 'STR) (WCMATCH nent_302 "*#*") (WCMATCH nent2_302 "*#*") ) ;_ end of AND (PROGN (SETQ drv_size2 nent_302) (WHILE (NOT (WCMATCH (SETQ drv_size2 (SUBSTR drv_size2 2)) "#*"))) (IF (WCMATCH drv_size2 "#,##") NIL (WHILE (NOT (WCMATCH (SETQ drv_size2 (SUBSTR drv_size2 1 (1- (STRLEN drv_size2)))) "#,##")) ) ;_ end of WHILE ) ;_ end of IF (SETQ drv_size2 (ATOF drv_size2)) (SETQ drv_size3 nent2_302) (WHILE (NOT (WCMATCH (SETQ drv_size3 (SUBSTR drv_size3 2)) "#*"))) (IF (WCMATCH drv_size3 "#,##") NIL (WHILE (NOT (WCMATCH (SETQ drv_size3 (SUBSTR drv_size3 1 (1- (STRLEN drv_size3)))) "#,##")) ) ;_ end of WHILE ) ;_ end of IF (SETQ drv_size3 (ATOF drv_size3)) ) ;_ end of PROGN ) ;_ end of IF (SETQ drv_point_lst (APPEND drv_point_lst (LIST drv_point2))) (SETQ nnent2_data (LIST (CONS 0 "AECC_POINT") (CONS 11 drv_point2) (CONS 302 (IF nent2_302 nent2_302 pick_302 ) ;_ end of IF ) ;_ end of CONS (CONS 303 (IF nent2_303 nent2_303 pick_303 ) ;_ end of IF ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of SETQ ) ;_ end of PROGN (PROGN (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: Failed AECC_POINT/Block test" ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "osmode" 512) (SETQ drv_point (upoint 1 "" "\nSelect road or driveway center point away from road" nil eop_point) ) ;_ end of SETQ (SETQ drv_point_lst (APPEND drv_point_lst (LIST drv_point))) (SETQ nent_data (LIST (CONS 0 "AECC_POINT") (CONS 11 drv_point) (CONS 302 pick_302) (CONS 303 pick_302) ) ;_ end of LIST ) ;_ end of SETQ (SETQ drv_point2 (upoint 1 "" "\nSelect road or driveway center point of continuation away from road" nil drv_point ) ;_ end of upoint ) ;_ end of SETQ (SETQ drv_point_lst (APPEND drv_point_lst (LIST drv_point2))) (SETQ nnent_data (LIST (CONS 0 "AECC_POINT") (CONS 11 drv_point2) (CONS 302 pick_302) (CONS 303 pick_302) ) ;_ end of LIST ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (IF (OR (NOT next_pnt) (NOT (EQ (CDR (ASSOC 0 (ENTGET (CAR next_pnt)))) "AECC_COGO_POINT"))) (PROGN (SETQ nent_10x (CADR (ASSOC 11 nent_data))) (SETQ nent_10y (CADDR (ASSOC 11 nent_data))) (SETQ nent_10z (CADDDR (ASSOC 11 nent_data))) (SETQ nent_10 (LIST nent_10x nent_10y nent_10z)) (SETQ nent_302 (STRCASE (IF (CDR (ASSOC 302 nent_data)) (CDR (ASSOC 302 nent_data)) "" ) ;_ end of IF ) ;_ end of STRCASE ) ;_ end of SETQ (SETQ nent_303 (STRCASE (IF (CDR (ASSOC 303 nent_data)) (CDR (ASSOC 303 nent_data)) "" ) ;_ end of IF ) ;_ end of STRCASE ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (SETQ el_adj_val 0) (SETQ this_nent_302 nent_302) (IF (WCMATCH nent_302 "*#*") (PROGN (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: nent_302 = " nent_302 ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (PROGN (SETQ drv_size2 (ureal 1 "Pick" "Width of drive? [Pick]" (IF drv_size2 drv_size2 10.0 ) ;_ end of if ) ;_ end of uint ) ;_ end of SETQ (IF (EQ drv_size2 "Pick") (PROGN (SETQ drv_size2_pt1 (upoint 1 "" "Pick 1st width point" nil nil)) (SETQ drv_size2_pt2 (upoint 1 "" "Pick 2nd width point" nil drv_size2_pt1)) (SETQ drv_size2 (DISTANCE (REVERSE (CDR (REVERSE drv_size2_pt1))) (REVERSE (CDR (REVERSE drv_size2_pt2))) ) ;_ end of DISTANCE ) ;_ end of SETQ (SETQ drv_size3 drv_size2) (SETQ orig_drv_point drv_point drv_point (POLAR drv_size2_pt1 (ANGLE drv_size2_pt1 drv_size2_pt2) (/ drv_size2 2.0)) ) ;_ end of SETQ (IF drv_point2 (SETQ drv_point2 (POLAR drv_point (ANGLE (IF orig_drv_point orig_drv_point drv_point ) ;_ end of IF drv_point2 ) ;_ end of ANGLE (DISTANCE (REVERSE (CDR (REVERSE (IF orig_drv_point orig_drv_point drv_point ) ;_ end of IF ) ;_ end of REVERSE ) ;_ end of CDR ) ;_ end of REVERSE (REVERSE (CDR (REVERSE drv_point2))) ) ;_ end of DISTANCE ) ;_ end of POLAR ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of PROGN (SETQ drv_size3 drv_size2) ) ;_ end of IF (COND ((WCMATCH (STRCASE nent_302) "*ARD*,*ASP*RD*,*ASP*ROAD*") (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 1) "' ASPHALT ROAD")) ) ((OR (WCMATCH (STRCASE nent_302) "*ASP*") (WCMATCH (STRCASE nent_302) "*ASP*D*R*") (WCMATCH (STRCASE nent_302) "*#AD") (WCMATCH (STRCASE nent_302) "*#'AD") (WCMATCH (STRCASE nent_302) "*#ADR") (WCMATCH (STRCASE nent_302) "*#'ADR") (WCMATCH (STRCASE nent_302) "*# AD") (WCMATCH (STRCASE nent_302) "*#' AD") (WCMATCH (STRCASE nent_302) "*# ADR") (WCMATCH (STRCASE nent_302) "*#' ADR") (WCMATCH (STRCASE nent_302) "*#AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' ADR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*ASPH*") ) ;_ end of IF ) ;_ end of OR (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 1) "' ASPHALT DRIVE")) ) ((OR (WCMATCH (STRCASE nent_302) "*GR*DR*") (WCMATCH (STRCASE nent_302) "*#GD") (WCMATCH (STRCASE nent_302) "*#'GD") (WCMATCH (STRCASE nent_302) "*#GDR") (WCMATCH (STRCASE nent_302) "*#'GDR") (WCMATCH (STRCASE nent_302) "*# GD") (WCMATCH (STRCASE nent_302) "*#' GD") (WCMATCH (STRCASE nent_302) "*# GDR") (WCMATCH (STRCASE nent_302) "*#' GDR") (WCMATCH (STRCASE nent_302) "*#GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' GDR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*GR*") ) ;_ end of IF ) ;_ end of OR (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 0) "' GRAVEL DRIVE")) ) ((WCMATCH (STRCASE nent_302) "*GRD*,*GR*RD*,*GR*ROAD*") (SETQ nent_302 (STRCAT "CL" (RTOS drv_size1 2 0) "' GRAVEL ROAD")) ) ((OR (WCMATCH (STRCASE nent_302) "*CONC*DR*") (WCMATCH (STRCASE nent_302) "*#CD") (WCMATCH (STRCASE nent_302) "*#'CD") (WCMATCH (STRCASE nent_302) "*#CDR") (WCMATCH (STRCASE nent_302) "*#'CDR") (WCMATCH (STRCASE nent_302) "*# CD") (WCMATCH (STRCASE nent_302) "*#' CD") (WCMATCH (STRCASE nent_302) "*# CDR") (WCMATCH (STRCASE nent_302) "*#' CDR") (WCMATCH (STRCASE nent_302) "*#CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' CDR[/@&+E][EPO]*") ) ;_ end of OR (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 0) "' CONCRETE DRIVE")) ) ((WCMATCH (STRCASE nent_302) "*SRD*,*SOIL*RD*,*SOIL*ROAD*") (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 1) "' SOIL ROAD")) ) ((OR (WCMATCH (STRCASE nent_302) "*SOIL*") (WCMATCH (STRCASE nent_302) "*#SD") (WCMATCH (STRCASE nent_302) "*#'SD") (WCMATCH (STRCASE nent_302) "*#SDR") (WCMATCH (STRCASE nent_302) "*#'SDR") (WCMATCH (STRCASE nent_302) "*# SD") (WCMATCH (STRCASE nent_302) "*#' SD") (WCMATCH (STRCASE nent_302) "*# SDR") (WCMATCH (STRCASE nent_302) "*#' SDR") (WCMATCH (STRCASE nent_302) "*#SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' SDR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*SOIL*") ) ;_ end of IF ) ;_ end of OR (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 1) "' SOIL DRIVE")) ) (T (IF pick_302 NIL (SETQ pick_302 (ukword 1 "Asphalt Concrete Gravel Soil" "\nType of driveway [Asphalt/Concrete/Gravel/Soil]" (IF pick_302 pick_302 (IF this_drive_matl this_drive_matl "Gravel" ) ;_ end of IF ) ;_ end of IF ) ;_ end of ukword this_drive_matl pick_302 ) ;_ end of SETQ ) ;_ end of IF (SETQ nent_302 (STRCAT "CL" (RTOS drv_size2 2 1) "' " (STRCASE pick_302) " DRIVE")) ) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF (COND ((OR ;;(WCMATCH nent_302 "*CL#*") (WCMATCH nent_302 "*@@#*") ;CL or OP (WCMATCH nent_302 "*@@##*") ;CL (WCMATCH nent_302 "*@@ #*") ;CL (WCMATCH nent_302 "*@@-#*") ;CL (WCMATCH nent_302 "*@@#F*") ;CL (WCMATCH nent_302 "*@@##F*") ;CL ) ;_ end of or (PRINC (STRCAT " " nent_302 " ")) (PRINC) (SETQ defadjcnt 1) (WHILE (OR (WCMATCH (SUBSTR nent_302 defadjcnt) "*@@#*") ;CL or OP (WCMATCH (SUBSTR nent_302 defadjcnt) "*@@ #*") ;CL (WCMATCH (SUBSTR nent_302 defadjcnt) "*@@-#*") ;CL ) ;_ end of OR (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #2A" (SUBSTR def_adj_val2 defadjcnt2) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ def_adj_val2 (SUBSTR nent_302 (1+ defadjcnt))) (SETQ defadjcnt2 1) (WHILE (OR (WCMATCH (SUBSTR def_adj_val2 defadjcnt2) "*#*") (WCMATCH (SUBSTR def_adj_val2 defadjcnt2) "*#F*") ) ;_ end of or (SETQ defadjcnt2 (1+ defadjcnt2)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #2B " (SUBSTR def_adj_val2 defadjcnt2) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (SETQ drvp2d (ABS (/ (READ (SUBSTR def_adj_val2 1 (1- defadjcnt2))) 2.0))) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2(A) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ drvbp2 (LIST nent_10x nent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2(B) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ((OR (WCMATCH nent_302 "*@@ #'*") ;CL (WCMATCH nent_302 "*@@ ##'*") ;CL (WCMATCH nent_302 "*@@ #F*") ;CL (WCMATCH nent_302 "*@@ ##F*") ;CL ) ;_ end of or (PRINC (STRCAT " " nent_302 " ")) (PRINC) (SETQ defadjcnt 1) (WHILE (WCMATCH (SUBSTR nent_302 defadjcnt) "*@@ #*") (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #2C " (SUBSTR nent_302 defadjcnt) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ def_adj_val2 (SUBSTR nent_302 (1+ defadjcnt))) (SETQ defadjcnt2 1) (WHILE (OR (WCMATCH (SUBSTR def_adj_val2 defadjcnt2) "*#'*") (WCMATCH (SUBSTR def_adj_val2 defadjcnt2) "*#F*") ) ;_ end of or (SETQ defadjcnt2 (1+ defadjcnt2)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #2D " (SUBSTR def_adj_val2 defadjcnt2) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (SETQ drvp2d (ABS (/ (READ (SUBSTR def_adj_val2 1 (1- defadjcnt2))) 2.0))) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2(C) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ drvbp2 (LIST nent_10x nent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2(D) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) (T (PRINC (STRCAT " " nent_302 " ")) (PRINC) (SETQ defadjcnt 1) (IF (WCMATCH nent_302 "*#*") (PROGN (WHILE (NOT (WCMATCH (SUBSTR nent_302 defadjcnt) "#*")) (SETQ defadjcnt (1+ defadjcnt)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #2C " (SUBSTR nent_302 defadjcnt) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ def_adj_val2 (SUBSTR nent_302 defadjcnt)) (SETQ defadjcnt2 (STRLEN def_adj_val2)) (WHILE (NOT (WCMATCH (SUBSTR def_adj_val2 1 defadjcnt2) "#,##")) (SETQ defadjcnt2 (1- defadjcnt2)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: COND #2D " (SUBSTR def_adj_val2 defadjcnt2) ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (SETQ drvp2d (ABS (/ (READ (SUBSTR def_adj_val2 1 defadjcnt2)) 2.0))) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2(C) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ drvbp2 (LIST nent_10x nent_10y 0.0)) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2(D) = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ) ;_ end of cond (IF (AND drvbp1 drvbp2) (PROGN (PROGN (SETVAR "osmode" 512) (IF debug_drvw (PROGN (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp1 = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp1) (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: drvbp2 = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC drvbp2) (PRINC (STRCAT "\n" (IF debug_pads debug_pads "\t" ) ;_ end of IF "DRIVEWAY: nent_302 = " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC nent_302) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (GRDRAW drvbp1 (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) 7) (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (- (ANGLE drvbp1 drvbp2) (/ PI 3.0)) 2.0 ) ;_ end of polar 7 ) ;_ end of grdraw (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (- (ANGLE drvbp1 drvbp2) (/ PI 1.5)) 2.0 ) ;_ end of polar 7 ) ;_ end of grdraw (SETQ inteop1 (upoint 1 "" "\nSelect edge of pavement line for driveway: " nil drvbp1)) (GRDRAW drvbp1 (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) -7) (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (- (ANGLE drvbp1 drvbp2) (/ PI 3.0)) 2.0 ) ;_ end of polar -7 ) ;_ end of grdraw (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) 10.0) (- (ANGLE drvbp1 drvbp2) (/ PI 1.5)) 2.0 ) ;_ end of polar -7 ) ;_ end of grdraw (GRDRAW drvbp1 (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) 7) (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (+ (ANGLE drvbp1 drvbp2) (/ PI 3.0)) 2.0 ) ;_ end of polar 7 ) ;_ end of grdraw (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (+ (ANGLE drvbp1 drvbp2) (/ PI 1.5)) 2.0 ) ;_ end of polar 7 ) ;_ end of grdraw ) ;_ end of PROGN (PROGN (SETQ inteop2 (upoint 1 "" "\nSelect edge of pavement line for right edge of driveway: " nil drvbp1 ) ;_ end of upoint ) ;_ end of SETQ (GRDRAW drvbp1 (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) -7) (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (+ (ANGLE drvbp1 drvbp2) (/ PI 3.0)) 2.0 ) ;_ end of polar -7 ) ;_ end of grdraw (GRDRAW (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (POLAR (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) 10.0) (+ (ANGLE drvbp1 drvbp2) (/ PI 1.5)) 2.0 ) ;_ end of polar -7 ) ;_ end of grdraw (REDRAW) ) ;_ end of PROGN (SETVAR "osmode" old_drvwosmode) ) ;_ end of PROGN ) ;_ end of IF (COND ((OR (WCMATCH (STRCASE ent_302) "*ARD*,*ASP*RD*,*ASP*ROAD*,") (WCMATCH (STRCASE nent_302) "*ARD*,*ASP*RD*,*ASP*ROAD*,") ) ;_ end of OR (SETQ ent_lay "C-ROAD6ASPH-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*ASP*DR*") (WCMATCH (STRCASE ent_302) "*#AD") (WCMATCH (STRCASE ent_302) "*#'AD") (WCMATCH (STRCASE ent_302) "*#ADR") (WCMATCH (STRCASE ent_302) "*#'ADR") (WCMATCH (STRCASE ent_302) "*# AD") (WCMATCH (STRCASE ent_302) "*# A-DR") (WCMATCH (STRCASE ent_302) "*#' AD") (WCMATCH (STRCASE ent_302) "*# ADR") (WCMATCH (STRCASE ent_302) "*#' ADR") (WCMATCH (STRCASE ent_302) "*#AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#ADR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'ADR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' AD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# ADR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*ASP*DR*") (WCMATCH (STRCASE nent_302) "*#AD") (WCMATCH (STRCASE nent_302) "*#'AD") (WCMATCH (STRCASE nent_302) "*#ADR") (WCMATCH (STRCASE nent_302) "*#'ADR") (WCMATCH (STRCASE nent_302) "*# AD") (WCMATCH (STRCASE nent_302) "*# A-DR") (WCMATCH (STRCASE nent_302) "*#' AD") (WCMATCH (STRCASE nent_302) "*# ADR") (WCMATCH (STRCASE nent_302) "*#' ADR") (WCMATCH (STRCASE nent_302) "*#AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' AD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# ADR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' ADR[/@&+E][EPO]*") (IF pick_302 (WCMATCH (STRCASE pick_302) "*ASPH*DR*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_lay "C-DRIV6ASPH-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*GR*V*DR*") (WCMATCH (STRCASE ent_302) "*#GD") (WCMATCH (STRCASE ent_302) "*#'GD") (WCMATCH (STRCASE ent_302) "*#GDR") (WCMATCH (STRCASE ent_302) "*#'GDR") (WCMATCH (STRCASE ent_302) "*# GD") (WCMATCH (STRCASE ent_302) "*# G-DR") (WCMATCH (STRCASE ent_302) "*#' GD") (WCMATCH (STRCASE ent_302) "*# GDR") (WCMATCH (STRCASE ent_302) "*#' GDR") (WCMATCH (STRCASE ent_302) "*#GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#GDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'GDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' GD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# GDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*GR*V*DR*") (WCMATCH (STRCASE nent_302) "*#GD") (WCMATCH (STRCASE nent_302) "*#'GD") (WCMATCH (STRCASE nent_302) "*#GDR") (WCMATCH (STRCASE nent_302) "*#'GDR") (WCMATCH (STRCASE nent_302) "*# GD") (WCMATCH (STRCASE nent_302) "*# G-DR") (WCMATCH (STRCASE nent_302) "*#' GD") (WCMATCH (STRCASE nent_302) "*# GDR") (WCMATCH (STRCASE nent_302) "*#' GDR") (WCMATCH (STRCASE nent_302) "*#GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' GD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# GDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' GDR[/@&+E][EPO]*") (AND (WCMATCH (STRCASE nent_302) "*GR*") (NOT (WCMATCH (STRCASE nent_302) "*ROAD*")) ;(NOT (WCMATCH (STRCASE nent_302) "*RD*")) ) ;_ end of AND ) ;_ end of OR (SETQ ent_lay "C-DRIV7GRVL-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*GRV*RD*,*GRAV*RD*,*GR*RD*,*GRV*ROAD*,*GRAV*ROAD*,*GR*ROAD*") (WCMATCH (STRCASE nent_302) "*GRV*RD*,*GRAV*RD*,*GR*RD*,*GRV*ROAD*,*GRAV*ROAD*,*GR*ROAD*") ) ;_ end of OR (SETQ ent_lay "C-ROAD7GRVL-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*CRD*,*CONC*RD*,*CONC*ROAD*") (WCMATCH (STRCASE nent_302) "*CRD*,*CONC*RD*,*CONC*ROAD*") ) ;_ end of OR (SETQ ent_lay "C-ROAD6CONC-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*CDR*,*CONC*DR*") (WCMATCH (STRCASE ent_302) "*#CD") (WCMATCH (STRCASE ent_302) "*#'CD") (WCMATCH (STRCASE ent_302) "*#CDR") (WCMATCH (STRCASE ent_302) "*#'CDR") (WCMATCH (STRCASE ent_302) "*# CD") (WCMATCH (STRCASE ent_302) "*# C-DR") (WCMATCH (STRCASE ent_302) "*#' CD") (WCMATCH (STRCASE ent_302) "*# CDR") (WCMATCH (STRCASE ent_302) "*#' CDR") (WCMATCH (STRCASE ent_302) "*#CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#CDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'CDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' CD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# CDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*CDR*,*CONC*DR*") (WCMATCH (STRCASE nent_302) "*#CD") (WCMATCH (STRCASE nent_302) "*#'CD") (WCMATCH (STRCASE nent_302) "*#CDR") (WCMATCH (STRCASE nent_302) "*#'CDR") (WCMATCH (STRCASE nent_302) "*# CD") (WCMATCH (STRCASE nent_302) "*# C-DR") (WCMATCH (STRCASE nent_302) "*#' CD") (WCMATCH (STRCASE nent_302) "*# CDR") (WCMATCH (STRCASE nent_302) "*#' CDR") (WCMATCH (STRCASE nent_302) "*#CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' CD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# CDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' CDR[/@&+E][EPO]*") (IF PICK_302 (WCMATCH (STRCASE pick_302) "*CONC*DR*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_lay "C-DRIV7CONC-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*SRD*,*SOIL*RD*,*SOIL*ROAD*") (WCMATCH (STRCASE nent_302) "*SRD*,*SOIL*RD*,*SOIL*ROAD*") ) ;_ end of OR (SETQ ent_lay "C-ROAD7SOIL-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ ) ((OR (WCMATCH (STRCASE ent_302) "*SOIL*") (WCMATCH (STRCASE ent_302) "*#SD") (WCMATCH (STRCASE ent_302) "*#'SD") (WCMATCH (STRCASE ent_302) "*#SDR") (WCMATCH (STRCASE ent_302) "*#'SDR") (WCMATCH (STRCASE ent_302) "*# SD") (WCMATCH (STRCASE ent_302) "*# S-DR") (WCMATCH (STRCASE ent_302) "*#' SD") (WCMATCH (STRCASE ent_302) "*# SDR") (WCMATCH (STRCASE ent_302) "*#' SDR") (WCMATCH (STRCASE ent_302) "*#SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#SDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#'SDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' SD[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*# SDR[/@&+E][EPO]*") (WCMATCH (STRCASE ent_302) "*#' SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*SOIL*") (WCMATCH (STRCASE nent_302) "*#SD") (WCMATCH (STRCASE nent_302) "*#'SD") (WCMATCH (STRCASE nent_302) "*#SDR") (WCMATCH (STRCASE nent_302) "*#'SDR") (WCMATCH (STRCASE nent_302) "*# SD") (WCMATCH (STRCASE nent_302) "*# S-DR") (WCMATCH (STRCASE nent_302) "*#' SD") (WCMATCH (STRCASE nent_302) "*# SDR") (WCMATCH (STRCASE nent_302) "*#' SDR") (WCMATCH (STRCASE nent_302) "*#SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#'SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' SD[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*# SDR[/@&+E][EPO]*") (WCMATCH (STRCASE nent_302) "*#' SDR[/@&+E][EPO]*") (IF PICK_302 (WCMATCH (STRCASE pick_302) "*SOIL*DR*") ) ;_ end of IF ) ;_ end of OR (SETQ ent_lay "C-DRIV7SOIL-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) (T (PRINC "\n") (PRINC (STRCASE nent_302)) (PRINC) (SETQ this_drive_type (ukword 1 "Road Drive" "\nType [Road/Drive]" (IF this_drive_type this_drive_type "Drive" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (SETQ this_drive_matl (ukword 1 "Asphalt Concrete Gravel Soil" "\nType of pavement [Asphalt/Concrete/Gravel/Soil]" (IF this_drive_matl this_drive_matl "Gravel" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (COND ((WCMATCH (STRCASE this_drive_matl) "ASPHALT") (IF (EQ (STRCASE this_drive_type) "ROAD") (SETQ ent_lay "C-ROAD6ASPH-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ (SETQ ent_lay "C-DRIV6ASPH-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ;_ end of IF ) ((WCMATCH (STRCASE this_drive_matl) "CONCRETE") (IF (EQ (STRCASE this_drive_type) "ROAD") (SETQ ent_lay "C-ROAD6CONC-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ (SETQ ent_lay "C-DRIV7CONC-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ;_ end of IF ) ((WCMATCH (STRCASE this_drive_matl) "GRAVEL") (IF (EQ (STRCASE this_drive_type) "ROAD") (SETQ ent_lay "C-ROAD7GRAV-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ (SETQ ent_lay "C-DRIV7GRAV-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ;_ end of IF ) ((WCMATCH (STRCASE this_drive_matl) "SOIL") (IF (EQ (STRCASE this_drive_type) "ROAD") (SETQ ent_lay "C-ROAD7SOIL-E" brk_lay "V-TOPO-ROAD-CNTR-E" ) ;_ end of SETQ (SETQ ent_lay "C-DRIV7SOIL-E" brk_lay "V-TOPO-DRIV-CNTR-E" ) ;_ end of SETQ ) ;_ end of IF ) ) ;_ end of COND ) ) ;_ end of COND (IF (AND inteop1 inteop2 drvbp1 drvbp2 drvp1d drvp2d) (PROGN (SETQ drvpt1b (POLAR drvbp2 (IF (AND drvbp2 drv_point2) (+ (ANGLE drvbp2 drv_point2) (* PI 0.5)) (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) ) ;_ end of IF drvp2d ) ;_ end of POLAR drvpt1a (IF (AND drv_size1_pt1 drv_size1_pt2) (IF (< (DISTANCE (REVERSE (CDR (REVERSE drvpt1b))) (REVERSE (CDR (REVERSE drv_size1_pt1))) ) ;_ end of DISTANCE (DISTANCE (REVERSE (CDR (REVERSE drvpt1b))) (REVERSE (CDR (REVERSE drv_size1_pt2))) ) ;_ end of DISTANCE ) ;_ end of < drv_size1_pt1 drv_size1_pt2 ) ;_ end of IF (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) drvp1d) ) ;_ end of IF drvpt1c (POLAR drvpt1b (ANGLE drvbp2 drv_point2) (DISTANCE (REVERSE (CDR (REVERSE drvbp2))) (REVERSE (CDR (REVERSE drv_point2)))) ) ;_ end of POLAR drvpt2a (IF (AND drv_size1_pt1 drv_size1_pt2) (IF (EQ drvpt1a drv_size1_pt1) drv_size1_pt2 drv_size1_pt1 ) ;_ end of IF (POLAR drvbp1 (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) drvp1d) ) ;_ end of IF drvpt2b (POLAR drvbp2 (IF (AND drvbp2 drv_point2) (+ (ANGLE drvbp2 drv_point2) (* PI 1.5)) (+ (ANGLE drvbp1 drvbp2) (* PI 1.5)) ) ;_ end of IF drvp2d ) ;_ end of POLAR drvpt2c (POLAR drvpt2b (ANGLE drvbp2 drv_point2) (DISTANCE (REVERSE (CDR (REVERSE drvbp2))) (REVERSE (CDR (REVERSE drv_point2)))) ) ;_ end of POLAR drvpt1c (IF (EQ drv_size2 drv_size3) drvpt1c (POLAR drvpt1c (+ (ANGLE drvbp2 drv_point2) (* PI 1.5)) (/ (- drv_size2 drv_size3) 2.0) ) ;_ end of POLAR ) ;_ end of IF drvpt2c (IF (EQ drv_size2 drv_size3) drvpt2c (POLAR drvpt2c (+ (ANGLE drvbp2 drv_point2) (* PI 0.5)) (/ (- drv_size2 drv_size3) 2.0) ) ;_ end of POLAR ) ;_ end of IF ) ;_ end of SETQ (SETQ interpt1a drvbp1 interpt1b inteop1 interpt2a drvbp1 interpt2b inteop2 intpt1a (LIST (CAR interpt1a) (CADR interpt1a) 0.0) intpt1b (LIST (CAR interpt1b) (CADR interpt1b) 0.0) intpt2a (LIST (CAR interpt2a) (CADR interpt2a) 0.0) intpt2b (LIST (CAR interpt2b) (CADR interpt2b) 0.0) drvpt1a (IF (AND drv_size1_pt1 drv_size1_pt2) (IF (< (DISTANCE (REVERSE (CDR (REVERSE inteop1))) (REVERSE (CDR (REVERSE drv_size1_pt1))) ) ;_ end of DISTANCE (DISTANCE (REVERSE (CDR (REVERSE inteop1))) (REVERSE (CDR (REVERSE drv_size1_pt2))) ) ;_ end of DISTANCE ) ;_ end of < drv_size1_pt1 drv_size1_pt2 ) ;_ end of IF (POLAR drvbp1 (ANGLE drvbp1 inteop1) (/ drvp1d (ABS (COS (- (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) (ANGLE drvbp1 drvpt1a)))) ) ;_ end of / ) ;_ end of POLAR ) ;_ end of IF drvpt2a (IF (AND drv_size1_pt1 drv_size1_pt2) (IF (< (DISTANCE (REVERSE (CDR (REVERSE inteop2))) (REVERSE (CDR (REVERSE drv_size1_pt2))) ) ;_ end of DISTANCE (DISTANCE (REVERSE (CDR (REVERSE inteop2))) (REVERSE (CDR (REVERSE drv_size1_pt1))) ) ;_ end of DISTANCE ) ;_ end of < drv_size1_pt2 drv_size1_pt1 ) ;_ end of IF (POLAR drvbp1 (ANGLE drvbp1 inteop2) (/ drvp1d (ABS (COS (- (+ (ANGLE drvbp1 drvbp2) (* PI 0.5)) (ANGLE drvbp1 drvpt2a)))) ) ;_ end of / ) ;_ end of POLAR ) ;_ end of IF ) ;_ end of SETQ (SETQ ent_assoc_8 (CONS 8 ent_lay) brk_assoc_8 (CONS 8 brk_lay) ) ;_ end of SETQ (IF make_layer_ent nil (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! ") ) ;_ end of IF (make_layer_ent (LIST ent_assoc_8)) (make_layer_ent (LIST brk_assoc_8)) (SETQ poly_ss (SSADD)) (IF bulgebypnts NIL (LOAD "bulgebypnts" "\nFile BULGEBYPNTS.LSP not loaded! ") ) ;_ end of IF (IF bulgebypnts (PROGN (IF pttxt NIL (LOAD "pttxt" "\nFile PTTXT.LSP not loaded! ") ) ;_ end of if (IF (AND pttxt debugbulgepts) (PROGN (COND (eop_point (pttxt "BULGE_1_" "eop_point" nil nil)) (drv_point (pttxt "BULGE_1_" "drv_point" nil nil)) ) ;_ end of COND (pttxt "BULGE_1_" "ent_10" nil nil) (pttxt "BULGE_1_" "nent_10" nil nil) (pttxt "BULGE_1_" "drv_point2" nil nil) (pttxt "BULGE_1_" "eop_point" nil nil) (pttxt "BULGE_1_" "drvbp1" nil nil) (pttxt "BULGE_1_" "inteop1" nil nil) (pttxt "BULGE_1_" "drvpt1a" nil nil) (pttxt "BULGE_1_" "drvpt1b" nil nil) (pttxt "BULGE_1_" "drvpt1c" nil nil) ) ;_ end of PROGN ) ;_ end of IF (IF dotanarcs_set NIL (SETQ dotanarcs (ukword 1 "Tangent Straight" "Create tangent arcs or straight segments? [Tangent/Straight]" (IF dotanarcs dotanarcs "Tangent" ) ;_ end of if ) ;_ end of ukword dotanarcs_set T ) ;_ end of SETQ ) ;_ end of IF (IF (EQ dotanarcs "Tangent") (IF (< (DISTANCE (REVERSE (CDR (REVERSE inteop1))) (REVERSE (CDR (REVERSE drvpt1a)))) (DISTANCE (REVERSE (CDR (REVERSE inteop1))) (REVERSE (CDR (REVERSE drvpt1c)))) ) ;(EQUAL inteop1 drvpt1a 0.1) (PROGN (IF (AND drv_point drv_point2) (SETQ drvpt1c (POLAR drvpt1b (ANGLE drv_point drv_point2) (DISTANCE (REVERSE (CDR (REVERSE drvpt1b))) (REVERSE (CDR (REVERSE drvpt1c))) ) ;_ end of DISTANCE ) ;_ end of POLAR ) ;_ end of SETQ ) ;_ end of IF (bulgebypnts drvpt1c drvpt1b drvpt1a) ;points step towards edge of road ) ;_ end of PROGN (PROGN (IF (AND drv_point drv_point2) (SETQ drvpt1a (POLAR drvpt1b (ANGLE drv_point drv_point2) (DISTANCE (REVERSE (CDR (REVERSE drvpt1b))) (REVERSE (CDR (REVERSE drvpt1a))) ) ;_ end of DISTANCE ) ;_ end of POLAR ) ;_ end of SETQ ) ;_ end of IF (bulgebypnts drvpt1a drvpt1b drvpt1c) ;points step away from edge of road ) ;_ end of PROGN ) ;_ end of IF (SETQ arcbulge 0.0) ) ;_ end of IF (ENTMAKE (LIST (CONS 0 "POLYLINE") ent_assoc_8 (CONS 10 (LIST 0 0 0)))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt1c))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt1b) (CONS 42 arcbulge))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt1a))) (ENTMAKE (LIST (CONS 0 "SEQEND") ent_assoc_8)) (SETQ snap-angle (ANGLE (LIST (CAR drvpt1b) (CADR drvpt1b)) (LIST (CAR drvpt1c) (CADR drvpt1c))) ) ;_ end of SETQ (IF snap-angle (SETVAR "SNAPANG" snap-angle) ) ;_ end of IF (SETQ poly_ss (SSADD (ENTLAST) poly_ss)) ) ;_ end of PROGN (PROGN (ENTMAKE (LIST (CONS 0 "POLYLINE") ent_assoc_8 (CONS 10 (LIST 0 0 0)))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt1c))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt1b))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt1a))) (ENTMAKE (LIST (CONS 0 "SEQEND") ent_assoc_8)) (SETQ poly_ss (SSADD (ENTLAST) poly_ss)) ) ;_ end of PROGN ) ;_ end of IF (IF bulgebypnts (PROGN (IF pttxt NIL (LOAD "pttxt" "\nFile PTTXT.LSP not loaded! ") ) ;_ end of if (IF (AND pttxt debugbulgepts) (PROGN (COND (drv_point2 (pttxt "BULGE_2_" "drv_point2" nil nil))) (pttxt "BULGE_2_" "ent_10" nil nil) (pttxt "BULGE_2_" "nent_10" nil nil) (pttxt "BULGE_2_" "drv_point2" nil nil) (pttxt "BULGE_2_" "drvbp2" nil nil) (pttxt "BULGE_2_" "inteop2" nil nil) (pttxt "BULGE_2_" "drvpt2a" nil nil) (pttxt "BULGE_2_" "drvpt2b" nil nil) (pttxt "BULGE_2_" "drvpt2c" nil nil) ) ;_ end of PROGN ) ;_ end of IF (IF (EQ dotanarcs "Tangent") (IF (< (DISTANCE (REVERSE (CDR (REVERSE inteop2))) (REVERSE (CDR (REVERSE drvpt2a)))) (DISTANCE (REVERSE (CDR (REVERSE inteop2))) (REVERSE (CDR (REVERSE drvpt2c)))) ) ;(EQUAL inteop2 drvpt2a 0.1) (PROGN (IF (AND drv_point drv_point2) (SETQ drvpt2c (POLAR drvpt2b (ANGLE drv_point drv_point2) (DISTANCE (REVERSE (CDR (REVERSE drvpt2b))) (REVERSE (CDR (REVERSE drvpt2c))) ) ;_ end of DISTANCE ) ;_ end of POLAR ) ;_ end of SETQ ) ;_ end of IF (bulgebypnts drvpt2c drvpt2b drvpt2a) ;points step towards edge of road ) ;_ end of PROGN (PROGN (IF (AND drv_point drv_point2) (SETQ drvpt2a (POLAR drvpt2b (ANGLE drv_point drv_point2) (DISTANCE (REVERSE (CDR (REVERSE drvpt2b))) (REVERSE (CDR (REVERSE drvpt2a))) ) ;_ end of DISTANCE ) ;_ end of POLAR ) ;_ end of SETQ ) ;_ end of IF (bulgebypnts drvpt2a drvpt2b drvpt2c) ;points step away from edge of road ) ;_ end of PROGN ) ;_ end of IF (SETQ arcbulge 0.0) ) ;_ end of IF (ENTMAKE (LIST (CONS 0 "POLYLINE") ent_assoc_8 (CONS 10 (LIST 0 0 0)))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt2c))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt2b) (CONS 42 arcbulge))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt2a))) (ENTMAKE (LIST (CONS 0 "SEQEND") ent_assoc_8)) (SETQ poly_ss (SSADD (ENTLAST) poly_ss)) ) ;_ end of PROGN (PROGN (ENTMAKE (LIST (CONS 0 "POLYLINE") ent_assoc_8 (CONS 10 (LIST 0 0 0)))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt2c))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt2b))) (ENTMAKE (LIST (CONS 0 "VERTEX") ent_assoc_8 (CONS 10 drvpt2a))) (ENTMAKE (LIST (CONS 0 "SEQEND") ent_assoc_8)) (SETQ poly_ss (SSADD (ENTLAST) poly_ss)) (SETQ tail_ss (SSADD (ENTLAST) tail_ss)) ) ;_ end of PROGN ) ;_ end of IF (IF (OR (EQ ent_10z 0.0) (EQ nent_10z 0.0)) NIL (PROGN (ENTMAKE (LIST (CONS 0 "POLYLINE") brk_assoc_8 (CONS 10 (LIST 0 0 0)) (CONS 70 8))) (ENTMAKE (LIST (CONS 0 "VERTEX") brk_assoc_8 (CONS 10 (LIST ent_10x ent_10y ent_10z)) (CONS 70 32)) ) ;_ end of ENTMAKE (ENTMAKE (LIST (CONS 0 "VERTEX") brk_assoc_8 (CONS 10 (LIST nent_10x nent_10y nent_10z)) (CONS 70 32) ) ;_ end of LIST ) ;_ end of ENTMAKE (IF (AND drv_point2 (/= (CADDR drv_point2) 0.0)) (ENTMAKE (LIST (CONS 0 "VERTEX") brk_assoc_8 (CONS 10 drv_point2) (CONS 70 32))) ) ;_ end of IF (ENTMAKE (LIST (CONS 0 "SEQEND") brk_assoc_8)) (SETQ poly_ss (SSADD (ENTLAST) poly_ss)) ) ;_ end of PROGN ) ;_ end of IF (SETQ entlaydef (TBLSEARCH "layer" ent_lay)) ) ;_ end of PROGN (PROGN (PRINC "\nSelected points do NOT have CL#' or CL#F in their descriptions! ") (PRINC "\n") (PRINC (MAPCAR 'EVAL '(inteop1 inteop2 drvbp1 drvbp2 drvp1d drvp2d))) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (IF c:tsnap NIL (LOAD "tsnap" "\nFile TSNAP.LSP not loaded! ")) (if C:TSNAP (c:tsnap)) (SETQ dotanarcs_sdet NIL) (IF old_drvw_snapang (SETVAR "SNAPANG" old_drvw_snapang) ) ;_ end of IF (IF old_drvwerror (SETQ *error* old_drvwerror) ) ;_ end of IF (IF old_drvwosmode (SETVAR "osmode" old_drvwosmode) ) ;_ end of IF (COMMAND ".undo" "end") (IF debug_pads ;unindents debug text upon leaving this function (SETQ debug_pads (SUBSTR debug_pads 2)) ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:rdrv () (IF (OR (AND tail_ss (EQ (SSLENGTH tail_ss) 2)) poly_ss) (PROGN (IF (AND drvbp2 (EQ (TYPE drvbp2) 'LIST)) NIL (SETQ drvbp2 (upoint 1 "" "Rotation point" nil nil)) ) ;_ end of IF (IF (AND tail_ss (EQ (SSLENGTH tail_ss) 2)) (PROGN (SETQ tail_ent1 (ENTGET (SSNAME tail_ss 0)) tail_ang (uangle 1 "" "New angle" nil drvbp2) drvbp3 (POLAR drvbp2 tail_ang (DISTANCE (CDR (ASSOC 10 tail_ent1)) (CDR (ASSOC 11 tail_ent1)))) drvpt2br (POLAR drvbp2 (+ (ANGLE drvbp2 drvbp3) (* PI 1.5)) drvp2d) drvpt2bl (POLAR drvbp2 (+ (ANGLE drvbp2 drvbp3) (* PI 0.5)) drvp2d) drvpt3br (POLAR drvpt2br (ANGLE drvbp2 drvbp3) (DISTANCE (CDR (ASSOC 10 tail_ent1)) (CDR (ASSOC 11 tail_ent1))) ) ;_ end of POLAR drvpt3bl (POLAR drvpt2bl (ANGLE drvbp2 drvbp3) (DISTANCE (CDR (ASSOC 10 tail_ent1)) (CDR (ASSOC 11 tail_ent1))) ) ;_ end of POLAR drvent1 (ENTGET (SSNAME tail_ss 0)) drvent2 (ENTGET (SSNAME tail_ss 1)) drvent1 (SUBST (CONS 10 drvpt2br) (ASSOC 10 drvent1) drvent1) drvent1 (SUBST (CONS 11 drvpt3br) (ASSOC 11 drvent1) drvent1) drvent2 (SUBST (CONS 10 drvpt2bl) (ASSOC 10 drvent2) drvent2) drvent2 (SUBST (CONS 11 drvpt3bl) (ASSOC 11 drvent2) drvent2) ) ;_ end of SETQ (ENTMOD drvent1) (ENTMOD drvent2) ) ;_ end of PROGN ) ;_ end of IF (PROGN (COMMAND ".ROTATE" poly_ss "" drvbp2 pause)) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:drvw () (c:driveway)) (PRINC) ;;;**************************************************************************** ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ***Don't add text below the comment!***|;