;;;Draws Handrail ;;;(constructs any closed polyline, varying width, parallel line object with ;;;flat, round, and/or 45° pointed ends) ;;;Optionally, pointed ends may be 'long' or 'short', and 'above' or 'below', to ;;;simulate angled intersections (±45°) to the drawing plane in one or two axes. ;;; ;;;Use draworder to arrange parts as required. Use two adjoiningparts with ;;;'open' ends where one end is above and the other end is below another part. ;;; ;;;Requires: MKLAYR.LSP, UUTILS.LSP ;;;Hiding requires: HDCIRC.DWG, HDBOX.DWG, 1X1.BMP ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; Copyright: 8-22-96 ;;; Edited: 1-22-2008 ;;; (DEFUN hrail_error (msg / tempss_len tempss_cnt) (SETQ tempss_len (IF temp_ss (SSLENGTH temp_ss) 0 ) ;_ end of IF tempss_cnt 0 ) ;_ end of setq (WHILE (< tempss_cnt tempss_len) (ENTDEL (SSNAME temp_ss tempss_cnt)) (SETQ tempss_cnt (1+ tempss_cnt)) ) ;_ end of while (SETQ *error* old_hrail_error) (PRINC "\n") (PRINC msg) (PRINC "\nERROR: Hrail cancelled! ") (PRINC) ) ;_ end of defun (DEFUN c:hrail (/ made_some_lines temp_ss arc_end1 arc_end2 hr_pnt_lst nxt_hr_pnt hr_pnt1 hr_pnt2 hr_pntl1 hr_pntl2 hr_pntr1 hr_pntr2 hr_ang1 hr_ang2 hrll_nxt1 hrrl_nxt1 ;;; hrpt_end1 ;"Round Point Flat Open" ;;; hrpt_end2 ;"Round Point Flat Open" ;;; hrpt_hide ;"Yes No" ;;; hrpt_od ;1.9 ;;; hrpt_list ;;; hrpt_cnt ) (IF trace_hrail (PROGN (trace hrail_error) (trace c:hrail) (trace c:mklayr) (trace ukword ureal upoint) (trace ukword ureal) (trace ukword) (trace undo) (trace c:svlayr) (trace c:rslayr) (trace force_layonthaw) (trace force_layunlock) (trace audit) (trace c:hrupd) ) ) (SETQ old_hrail_error *error*) (SETQ *error* hrail_error) (SETQ old_hrail_osmode (GETVAR "osmode")) (SETVAR "imagehlt" 1) (IF (OR (AND colri colra) colr) nil (SETQ colr "1" colri nil colra nil ) ;_ end of setq ) ;_ end of if (COND (colri (SETQ prev_colri colri)) (colr (SETQ prev_colr colr)) ) ;_ end of COND (IF c:mklayr nil (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ") ) ;_ end of if (IF (AND ukword ureal upoint) nil (FOREACH n (LIST "ukword" "ureal" "upoint") (LOAD n)) ) ;_ end of if (IF hrpt_end1 (SETQ end_cond1 hrpt_end1) (SETQ end_cond1 (ukword 1 "Round Point Flat Open" "First end " (IF end_cond1 end_cond1 "Round" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq ) ;_ end of IF (IF hrpt_end2 (SETQ end_cond2 hrpt_end2) (SETQ end_cond2 (ukword 1 "Round Point Flat Open" "Terminal end " (IF end_cond2 end_cond2 "Round" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq ) ;_ end of IF (IF hrpt_hide (SETQ do_hides hrpt_hide) (SETQ do_hides (ukword 1 "Yes No" "Create hiding blocks? " (IF do_hides do_hides "Yes" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ ) ;_ end of IF (SETVAR "PLINEWID" 0) (COND ((EQ end_cond1 "Round") (SETQ arc_end1 T pnt_end1 nil flt_end1 nil opn_end1 nil ) ;_ end of setq ) ((EQ end_cond1 "Point") (SETQ point_cond1 (ukword 1 "Long Short Normal" "Make first Point end " (IF point_cond1 point_cond1 "Normal" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (SETQ point_cond1a (ukword 1 "Above Below Normal" "Make first Point end Above or Below centerline " (IF point_cond1a point_cond1a "Normal" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (SETQ arc_end1 nil pnt_end1 T flt_end1 nil opn_end1 nil ) ;_ end of setq ) ((EQ end_cond1 "Flat") (SETQ arc_end1 nil pnt_end1 nil flt_end1 T opn_end1 nil ) ;_ end of setq ) ((EQ end_cond1 "Open") (SETQ arc_end1 nil pnt_end1 nil flt_end1 nil opn_end1 T ) ;_ end of setq ) ) ;_ end of COND (COND ((EQ end_cond2 "Round") (SETQ arc_end2 T pnt_end2 nil flt_end2 nil opn_end2 nil ) ;_ end of setq ) ((EQ end_cond2 "Point") (SETQ point_cond2 (ukword 1 "Long Short Normal" "Make terminal Point end " (IF point_cond2 point_cond2 "Normal" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (SETQ point_cond2a (ukword 1 "Above Below Normal" "Make terminal Point end Above or Below centerline " (IF point_cond2a point_cond2a "Normal" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (SETQ arc_end2 nil pnt_end2 T flt_end2 nil opn_end2 nil ) ;_ end of setq ) ((EQ end_cond2 "Flat") (SETQ arc_end2 nil pnt_end2 nil flt_end2 T opn_end2 nil ) ;_ end of setq ) ((EQ end_cond2 "Open") (SETQ arc_end2 nil pnt_end2 nil flt_end2 nil opn_end2 T ) ;_ end of setq ) ) ;_ end of COND (IF hrpt_od (SETQ rail_od hrpt_od) (SETQ rail_od (ureal 0 "" "Handrail O.D.: " (IF rail_od rail_od 1.9 ) ;_ end of if ) ;_ end of ureal ) ;_ end of setq ) ;_ end of IF (SETQ rail_hd (/ rail_od 2.0)) ;;; (SETQ hr_pnt_lst nil) (SETQ temp_ss (SSADD)) (SETVAR "plinetype" 0) (COMMAND ".undo" "begin") (WHILE (AND (NOT (EQ nxt_hr_pnt "Select")) (NOT hrpt_cnt) (SETQ nxt_hr_pnt (upoint 0 (IF nxt_hr_pnt "" "Select" ) ;_ end of IF (IF nxt_hr_pnt "Pick handrail Points" "Pick handrail points or elect polyline" ) ;_ end of IF nil (IF nxt_hr_pnt nxt_hr_pnt ) ;_ end of if ) ;_ end of upoint ) ;_ end of setq ) ;_ end of AND (IF (EQ nxt_hr_pnt "Select") NIL (PROGN (SETQ hr_pnt_lst (APPEND hr_pnt_lst (LIST (LIST (CAR nxt_hr_pnt) (CADR nxt_hr_pnt) (GETVAR "elevation"))))) (IF (> (LENGTH hr_pnt_lst) 1) (PROGN (IF (ENTMAKE (LIST (CONS 0 "line") ;create temporary lines so user can see points picked even after a redraw or zoom (CONS 8 "temp-hrail") (CONS 10 (CADR (REVERSE hr_pnt_lst))) (CONS 11 (CAR (REVERSE hr_pnt_lst))) ) ;_ end of LIST ) ;_ end of entmake (PROGN (SSADD (ENTLAST) temp_ss) (SETQ made_some_lines T)) ) ;_ end of IF ) ;_ end of progn ) ;_ end of if (IF hrpt_cnt (SETQ hrpt_cnt (1+ hrpt_cnt)) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (IF (EQ nxt_hr_pnt "Select") (PROGN (SETQ hrpline_ss NIL) (SETQ hrpline_ss (SSGET '((-4 . ""))));(0 . "LWPOLYLINE") (IF hrpline_ss (PROGN (SETQ this_pl_ename (SSNAME hrpline_ss 0) this_pl_edata (ENTGET this_pl_ename) ) ;_ end of SETQ (COND ((EQ (CDR (ASSOC 0 this_pl_edata)) "LWPOLYLINE");LWPolyline is not working properly so it has been removed from SSGET for hrpline_ss (SETQ this_plpnt this_pl_edata hrpt_list (LIST (LIST (CADR (ASSOC 10 this_plpnt)) (CADDR (ASSOC 10 this_plpnt)) (GETVAR "ELEVATION"))) ) ;_ end of SETQ (WHILE (SETQ this_plpnt (CDR (MEMBER (ASSOC 10 this_plpnt) this_plpnt))) (SETQ hrpt_list (LIST (LIST (CADR (ASSOC 10 this_plpnt)) (CADDR (ASSOC 10 this_plpnt)) (GETVAR "ELEVATION"))) ) ;_ end of SETQ ) ;_ end of WHILE ) ((EQ (CDR (ASSOC 0 this_pl_edata)) "POLYLINE") (SETQ next_pl_edata this_pl_edata hrpt_list NIL ) ;_ end of SETQ (WHILE (NOT (EQ (CDR (ASSOC 0 (SETQ next_pl_edata (ENTGET (ENTNEXT (CDR (ASSOC -1 next_pl_edata))))))) "SEQEND") ) ;_ end of NOT (SETQ hrpt_list (APPEND hrpt_list (LIST (LIST (CADR (ASSOC 10 next_pl_edata)) (CADDR (ASSOC 10 next_pl_edata)) (GETVAR "ELEVATION") ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of WHILE ) ) ;_ end of COND (ENTDEL this_pl_ename) (SETQ hr_pnt_lst hrpt_list hrpt_list NIL ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (IF (> (LENGTH hr_pnt_lst) 1) (PROGN (IF (EQ do_hides "Yes") (PROGN (IF (TBLOBJNAME "block" "hdcirc") nil (IF (FINDFILE "hdcirc.dwg") (PROGN (COMMAND ".-insert" "hdcirc") (COMMAND)) ;define block "hdcirc" ) ;_ end of progn ) ;_ end of IF (IF (TBLOBJNAME "block" "hdbox") nil (IF (FINDFILE "hdbox.dwg") (PROGN (COMMAND ".-insert" "hdbox") (COMMAND)) ;define block "hdbox" ) ;_ end of progn ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (c:svlayr) (SETQ hrail_ss (SSADD)) (SETQ mjrg "A" prod "METL" colr "6" modf "RAIL" ) ;_ end of SETQ (c:mklayr) (SETQ hr_pnt_cnt 1) (COND ((EQ point_cond1 "Long") (SETQ point_pnt1 (POLAR (CAR hr_pnt_lst) (ANGLE (CADR hr_pnt_lst) (CAR hr_pnt_lst)) (* rail_hd 0.5))) (SETQ picked_pnt1 (CAR hr_pnt_lst) hr_pnt_lst (APPEND (LIST point_pnt1) (CDR hr_pnt_lst)) ) ;_ end of SETQ ) ) ;_ end of COND (COND ((EQ point_cond2 "Long") (SETQ point_pnt2 (POLAR (CAR (REVERSE hr_pnt_lst)) (ANGLE (CADR (REVERSE hr_pnt_lst)) (CAR (REVERSE hr_pnt_lst))) (* rail_hd 0.5) ) ;_ end of POLAR ) ;_ end of SETQ (SETQ picked_pnt2 (CAR (REVERSE hr_pnt_lst)) hr_pnt_lst (REVERSE (APPEND (LIST point_pnt2) (CDR (REVERSE hr_pnt_lst)))) ) ;_ end of SETQ ) ) ;_ end of COND (WHILE (< hr_pnt_cnt (LENGTH hr_pnt_lst)) (SETQ hr_pnt1 (NTH (1- hr_pnt_cnt) hr_pnt_lst) ;rail segment first midpoint hr_pnt2 (NTH hr_pnt_cnt hr_pnt_lst) ;rail segment second midpoint (next rail first midpoint) hr_ang1 (+ (ANGLE hr_pnt1 hr_pnt2) (* PI 0.5)) ;perpindicular angle left hr_ang2 (+ (ANGLE hr_pnt1 hr_pnt2) (* PI 1.5)) ;perpindicular angle right hr_pntl1 (POLAR hr_pnt1 hr_ang1 rail_hd) ;left rail line first perpin. point hr_pntl2 (POLAR hr_pnt2 hr_ang1 rail_hd) ;left rail line second perpin. point hr_pntr1 (POLAR hr_pnt1 hr_ang2 rail_hd) ;right rail line first perpin. point hr_pntr2 (POLAR hr_pnt2 hr_ang2 rail_hd) ;right rail line second perpin. point ) ;_ end of setq (IF (AND hrll_nxt1 (NOT (AND (EQ hr_pnt_cnt 2) (EQ (LENGTH hr_pnt_lst) 2)))) (SETQ hrll_pnt1 hrll_nxt1 hrll_nxt1 nil ) ;_ end of setq ) ;_ end of if (IF (AND hrrl_nxt1 (NOT (AND (EQ hr_pnt_cnt 2) (EQ (LENGTH hr_pnt_lst) 2)))) (SETQ hrrl_pnt1 hrrl_nxt1 hrrl_nxt1 nil ) ;_ end of setq ) ;_ end of if (IF (< hr_pnt_cnt (1- (LENGTH hr_pnt_lst))) (PROGN (SETQ hr_nxt2 (NTH (+ hr_pnt_cnt 1) hr_pnt_lst) ;next rail segment second midpoint hr_nxang1 (+ (ANGLE hr_pnt2 hr_nxt2) (* PI 0.5)) ;next rail perpin. angle left hr_nxang2 (+ (ANGLE hr_pnt2 hr_nxt2) (* PI 1.5)) ;next rail perpin. angle right hr_nxtl1 (POLAR hr_pnt2 hr_nxang1 rail_hd) ;next left rail line first perpin. point hr_nxtl2 (POLAR hr_nxt2 hr_nxang1 rail_hd) ;next left rail line second perpin. point hr_nxtr1 (POLAR hr_pnt2 hr_nxang2 rail_hd) ;next right rail line first perpin. point hr_nxtr2 (POLAR hr_nxt2 hr_nxang2 rail_hd) ;next right rail line second perpin. point hrll_int2 (INTERS hr_pntl1 hr_pntl2 hr_nxtl1 hr_nxtl2 nil) ;left inters first/second rail hrrl_int2 (INTERS hr_pntr1 hr_pntr2 hr_nxtr1 hr_nxtr2 nil) ;right inters first/second rail ) ;_ end of SETQ (IF (> (DISTANCE hr_pntl1 hrll_int2) (DISTANCE hr_pntl1 hr_pntl2)) (SETQ hrll_pnt2 hr_pntl2 arc_endpt hr_pntl2 ) ;_ end of setq (SETQ hrll_pnt2 hrll_int2) ) ;_ end of IF (IF (> (DISTANCE hr_pntr1 hrrl_int2) (DISTANCE hr_pntr1 hr_pntr2)) (SETQ hrrl_pnt2 hr_pntr2 arc_begpt hr_pntr2 ) ;_ end of setq (SETQ hrrl_pnt2 hrrl_int2) ) ;_ end of IF (IF (> (DISTANCE hr_nxtl2 hrll_int2) (DISTANCE hr_nxtl2 hr_nxtl1)) (SETQ hrll_nxt1 hr_nxtl1 arc_begpt hr_nxtl1 ) ;_ end of setq (SETQ hrll_nxt1 hrll_int2) ) ;_ end of IF (IF (> (DISTANCE hr_nxtr2 hrrl_int2) (DISTANCE hr_nxtr2 hr_nxtr1)) (SETQ hrrl_nxt1 hr_nxtr1 arc_endpt hr_nxtr1 ) ;_ end of setq (SETQ hrrl_nxt1 hrrl_int2) ) ;_ end of IF ) ;_ end of PROGN (IF (EQ (LENGTH hr_pnt_lst) 2) (SETQ hrll_pnt2 hr_pntl2 hrrl_pnt2 hr_pntr2 arc_begpt hr_pntr2 arc_endpt hr_pntl2 ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of IF (IF debug_hrail (PROGN (PRINC "\nAbout to ENTMAKE block \"hdcirc\" (1)") (PRINC)) ) ;_ end of IF (IF (AND (EQ do_hides "Yes") (OR (> hr_pnt_cnt 1) arc_end1 pnt_end1) ;place first and intermediate corner hiding blocks (TBLOBJNAME "block" "hdcirc") (ENTMAKE (LIST (CONS 0 "insert") (CONS 2 "hdcirc") (CONS 8 "A-METL7RAIL-HIDE") (CONS 10 (LIST (CAR hr_pnt1) (CADR hr_pnt1) (1- (CADDR hr_pnt1)))) (CONS 41 (COND ((AND (EQUAL hr_pnt1 (CAR hr_pnt_lst) 0.001) (EQ point_cond1 "Short")) (* rail_od 0.5)) (T rail_od) ) ;_ end of COND ) ;_ end of CONS (CONS 42 rail_od) (CONS 43 rail_od) (CONS 50 (ANGLE (CAR hr_pnt_lst) (CADR hr_pnt_lst))) ) ;_ end of list ) ;_ end of entmake ) ;_ end of and (SSADD (ENTLAST) hrail_ss) ) ;_ end of if (IF debug_hrail (PROGN (PRINC "\nAbout to ENTMAKE block \"hdcirc\" (2)") (PRINC)) ) ;_ end of IF (IF (AND (EQ do_hides "Yes") (EQ hr_pnt_cnt (1- (LENGTH hr_pnt_lst))) ;place last corner hiding block (OR arc_end2 pnt_end2) (TBLOBJNAME "block" "hdcirc") (ENTMAKE (LIST (CONS 0 "insert") (CONS 2 "hdcirc") (CONS 8 "A-METL7RAIL-HIDE") (CONS 10 (LIST (CAR hr_pnt2) (CADR hr_pnt2) (1- (CADDR hr_pnt2)))) (CONS 41 (COND ((AND (EQUAL hr_pnt2 (CAR (REVERSE hr_pnt_lst)) 0.001) (EQ point_cond2 "Short")) (* rail_od 0.5)) (T rail_od) ) ;_ end of COND ) ;_ end of CONS (CONS 42 rail_od) (CONS 43 rail_od) (CONS 50 (ANGLE (CADR (REVERSE hr_pnt_lst)) (CAR (REVERSE hr_pnt_lst)))) ) ;_ end of list ) ;_ end of entmake ) ;_ end of and (SSADD (ENTLAST) hrail_ss) ) ;_ end of if (IF debug_hrail (PROGN (PRINC "\nAbout to ENTMAKE block \"hdbox\" (1)") (PRINC)) ) ;_ end of IF (IF (AND (EQ do_hides "Yes") (TBLOBJNAME "block" "hdbox") ;place pipe handrail hiding blocks (ENTMAKE (LIST (CONS 0 "insert") (CONS 2 "hdbox") (CONS 8 "A-METL7RAIL-HIDE") (CONS 10 (POLAR (LIST (CAR hr_pnt1) (CADR hr_pnt1) (1- (CADDR hr_pnt1))) hr_ang2 rail_hd)) (CONS 41 (DISTANCE hr_pnt1 hr_pnt2)) (CONS 42 rail_od) (CONS 43 1) (CONS 50 (ANGLE hr_pnt1 hr_pnt2)) ) ;_ end of list ) ;_ end of entmake ) ;_ end of and (SSADD (ENTLAST) hrail_ss) ) ;_ end of if (COND (prev_colri (SETQ colri prev_colri colr NIL ) ;_ end of SETQ ) (prev_colr (SETQ colr prev_colr colri NIL colra NIL ) ;_ end of SETQ ) ) ;_ end of COND ;;; (COND ;;; ((WCMATCH modf "[APS][LC][T1234567890]#") ;;; (SETQ usrd "HIDE")) ;;; ((AND usrd (WCMATCH usrd "[APS][LC][T1234567890]#")) ;;; (SETQ modf usrd ;;; usrd "HIDE")) ;;; (T (SETQ usrd nil ;;; modf "HAND" ;;; )) ;;; ) ;;; (c:mklayr) (SETQ rail_layer (GETVAR "clayer")) (SETQ lay0_stat (ENTGET (TBLOBJNAME "layer" "0"))) (force_layonthaw "0") (force_layunlock "0") (COND ((AND (EQ hr_pnt_cnt 1) arc_end1) (IF (ENTMAKE (LIST (CONS 0 "arc") (CONS 8 "0") (CONS 10 hr_pnt1) (CONS 40 rail_hd) (CONS 50 hr_ang1) (CONS 51 hr_ang2) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ((AND (EQ hr_pnt_cnt 1) pnt_end1) (IF (ENTMAKE (LIST (CONS 0 "line") (CONS 8 "0") (CONS 10 (POLAR hr_pnt1 hr_ang1 rail_hd)) (CONS 11 (POLAR (POLAR hr_pnt1 (+ hr_ang1 (* PI 0.5)) (* rail_hd (IF (EQ point_cond1 "Short") 0.5 1.0 ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR hr_ang1 (* rail_hd (COND ((EQ point_cond1a "Above") 0.5) ((EQ point_cond1a "Below") -0.5) (T 0.0) ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF (IF (ENTMAKE (LIST (CONS 0 "line") (CONS 8 "0") (CONS 10 (POLAR (POLAR hr_pnt1 (+ hr_ang1 (* PI 0.5)) (* rail_hd (IF (EQ point_cond1 "Short") 0.5 1.0 ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR hr_ang1 (* rail_hd (COND ((EQ point_cond1a "Above") 0.5) ((EQ point_cond1a "Below") -0.5) (T 0.0) ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR ) ;_ end of CONS (CONS 11 (POLAR hr_pnt1 hr_ang2 rail_hd)) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ((AND (EQ hr_pnt_cnt 1) flt_end1) (IF (ENTMAKE (LIST (CONS 0 "line") (CONS 8 "0") (CONS 10 (POLAR hr_pnt1 hr_ang1 rail_hd)) (CONS 11 (POLAR hr_pnt1 hr_ang2 rail_hd)) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ) ;_ end of COND (COND ((< hr_pnt_cnt (1- (LENGTH hr_pnt_lst))) (IF (ENTMAKE (LIST (CONS 0 "arc") (CONS 8 "0") (CONS 10 hr_pnt2) (CONS 40 rail_hd) (CONS 50 (ANGLE hr_pnt2 arc_begpt)) (CONS 51 (ANGLE hr_pnt2 arc_endpt)) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ((AND (EQ hr_pnt_cnt (1- (LENGTH hr_pnt_lst))) arc_end2) (IF (ENTMAKE (LIST (CONS 0 "arc") (CONS 8 "0") (CONS 10 hr_pnt2) (CONS 40 rail_hd) (CONS 50 hr_ang2) (CONS 51 hr_ang1) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ((AND (EQ hr_pnt_cnt (1- (LENGTH hr_pnt_lst))) pnt_end2) (IF (ENTMAKE (LIST (CONS 0 "line") (CONS 8 "0") (CONS 10 (POLAR hr_pnt2 hr_ang2 rail_hd)) (CONS 11 (POLAR (POLAR hr_pnt2 (+ hr_ang2 (* PI 0.5)) (* rail_hd (IF (EQ point_cond2 "Short") 0.5 1.0 ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR hr_ang2 (* rail_hd (COND ((EQ point_cond2a "Above") -0.5) ((EQ point_cond2a "Below") 0.5) (T 0.0) ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF (IF (ENTMAKE (LIST (CONS 0 "line") (CONS 8 "0") (CONS 10 (POLAR (POLAR hr_pnt2 (+ hr_ang2 (* PI 0.5)) (* rail_hd (IF (EQ point_cond2 "Short") 0.5 1.0 ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR hr_ang2 (* rail_hd (COND ((EQ point_cond2a "Above") -0.5) ((EQ point_cond2a "Below") 0.5) (T 0.0) ) ;_ end of IF ) ;_ end of * ) ;_ end of POLAR ) ;_ end of CONS (CONS 11 (POLAR hr_pnt2 hr_ang1 rail_hd)) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ((AND (EQ hr_pnt_cnt (1- (LENGTH hr_pnt_lst))) flt_end2) (IF (ENTMAKE (LIST (CONS 0 "line") (CONS 8 "0") (CONS 10 (POLAR hr_pnt2 hr_ang1 rail_hd)) (CONS 11 (POLAR hr_pnt2 hr_ang2 rail_hd)) ) ;_ end of LIST ) ;_ end of ENTMAKE (SSADD (ENTLAST) hrail_ss) ) ;_ end of IF ) ) ;_ end of COND (IF (EQ hr_pnt_cnt 1) (PROGN ;set left and right pnt1 and pnt2 for first rail (SETQ hrll_pnt1 (POLAR hr_pnt1 hr_ang1 rail_hd) hrrl_pnt1 (POLAR hr_pnt1 hr_ang2 rail_hd) ) ;_ end of setq ) ;_ end of progn ) ;_ end of if ;;; (IF ;;; (and (not (eq hr_pnt_cnt 1))(not (EQ hr_pnt_cnt (1- (LENGTH hr_pnt_lst))))) ;;; (progn ;set left and right pnt1 and pnt2 for intermediate rails ;;; ) ;;; ) (IF (AND (NOT (EQ hr_pnt_cnt 1)) (EQ hr_pnt_cnt (1- (LENGTH hr_pnt_lst)))) (PROGN ;set left and right pnt1 and pnt2 for last rail (SETQ hrll_pnt2 (POLAR hr_pnt2 hr_ang1 rail_hd) hrrl_pnt2 (POLAR hr_pnt2 hr_ang2 rail_hd) ) ;_ end of setq ) ;_ end of progn ) ;_ end of IF (IF (ENTMAKE (LIST (CONS 0 "line") ;create left line (CONS 8 "0") (CONS 10 hrll_pnt1) (CONS 11 hrll_pnt2) ) ;_ end of list ) ;_ end of entmake (SSADD (ENTLAST) hrail_ss) ) ;_ end of if ;;; (IF debugpts ;;; (PROGN ;;; (pttxt "HRAIL_" "hrll_pnt" 1 3) ;;; ) ;;; ) (IF (ENTMAKE (LIST (CONS 0 "line") ;create right line (CONS 8 "0") (CONS 10 hrrl_pnt1) (CONS 11 hrrl_pnt2) ) ;_ end of list ) ;_ end of entmake (SSADD (ENTLAST) hrail_ss) ) ;_ end of if ;;; (IF debugpts ;;; (PROGN ;;; (pttxt "HRAIL_" "hrrl_pnt" 1 3) ;;; ) ;;; ) (SETQ hr_pnt_cnt (1+ hr_pnt_cnt)) ) ;_ end of while ;;; (IF (EQ (CONS 10 hrrl_pnt1)(ASSOC 10(ENTGET(SSNAME hrail_ss (1-(SSLENGTH hrail_ss)))))) (PROGN (SETQ hrail_sscnt (SSLENGTH hrail_ss) pedit_ss (SSADD) ) ;_ end of SETQ (WHILE (> hrail_sscnt 0) (SETQ this_hrail (ENTGET (SSNAME hrail_ss (1- hrail_sscnt)))) (IF (OR (EQ (CDR (ASSOC 0 this_hrail)) "LINE") (EQ (CDR (ASSOC 0 this_hrail)) "ARC")) (PROGN (IF (NOT (EQ (CDR (ASSOC 8 this_hrail)) "0")) (PROGN (SETQ this_hrail (SUBST (CONS 8 "0") (ASSOC 8 this_hrail) this_hrail)) (ENTMOD this_hrail)) ) ;_ end of IF (SETQ pedit_ss (SSADD (CDR (ASSOC -1 this_hrail)) pedit_ss)) ) ;_ end of PROGN ) ;_ end of IF (SETQ hrail_sscnt (1- hrail_sscnt)) ) ;_ end of WHILE (COMMAND ".pedit" "m" pedit_ss "" "y" "j" "0.0" "") (COMMAND ".audit" "y") (PRINC "\nAutoCAD's PEDIT/Join option often causes layer table errors.") (PRINC "\nHRAIL ran AUDIT to fix any errors that AutoCAD's PEDIT/Join may have caused.\n") (PRINC) (SETQ ename_lst NIL) ;Pedit/multiple/join may create more than one polyline. ;In order to collect them all we step back through the (ENTLAST) function to find them ;and record their enames. Stepping requires deleting (ENTLAST) to expose the preceding ;entity to (ENTLAST). (ENTDEL ename) allows us to restore them afterwards using enames ;we stored in ename_lst. We add the entities to our selection set as they are retored. (WHILE (AND (SETQ this_ename (ENTLAST)) (EQ (CDR (ASSOC 0 (ENTGET this_ename))) "POLYLINE") (EQ (CDR (ASSOC 8 (ENTGET this_ename))) "0") ) ;_ end of AND (SETQ ename_lst (APPEND ename_lst (LIST this_ename))) (ENTDEL this_ename) ) ;_ end of WHILE (FOREACH n ename_lst (ENTDEL n) (SSADD n hrail_ss)) ;;; ;;; (COMMAND ".pedit" (ENTLAST) "Y" "J" pedit_ss "" "") ;;; ;;; (SETQ this_pline (ENTGET (ENTLAST))) ;;; ;;; (IF (EQ (CDR (ASSOC 0 this_pline)) "POLYLINE") ;;; ;;; (PROGN (SETQ this_vertex this_pline) ;;; ;;; (WHILE (NOT (EQ (CDR (ASSOC 0 this_vertex)) "SEQEND")) ;;; ;;; (SETQ this_vertex (ENTGET (ENTNEXT (CDR (ASSOC -1 this_vertex))))) ;;; ;;; (SETQ this_vertex (SUBST (CONS 8 "0") (ASSOC 8 this_vertex) this_vertex)) ;;; ;;; ;;; (PRINC "\n") ;;; ;;; ;;; (PRINC ;;; ;;; (ENTMOD this_vertex) ;;; ;;; ;;; ) ;;; ;;; ;;; (PRINC) ;;; ;;; ) ;_ end of WHILE ;;; ;;; (PRINC this_vertex) ;;; ;;; (ENTMOD this_pline) ;;; ;;; ) ;_ end of PROGN ;;; ;;; ) ;_ end of IF ;;; ;;; (SSADD (ENTLAST) hrail_ss) ;;; (SETQ hrail_sslen ;;; (SSLENGTH hrail_ss) ;;; hrail_sscnt 0 ;;; remain_ss (SSADD) ;;; ) ;_ end of setq ;;; (WHILE (< hrail_sscnt hrail_sslen) ;;; (IF (SETQ found_it (ENTGET (SSNAME hrail_ss hrail_sscnt))) ;;; (IF (OR (EQ (CDR (ASSOC 0 found_it)) "LINE") (EQ (CDR (ASSOC 0 found_it)) "ARC")) ;;; (PROGN (IF (NOT (EQ (CDR (ASSOC 8 found_it)) "0")) ;;; (PROGN (SETQ found_it (SUBST (CONS 8 "0") (ASSOC 8 found_it) found_it)) (ENTMOD found_it)) ;;; ) ;_ end of IF ;;; (SETQ remain_ename (CDR (ASSOC -1 found_it))) ;;; (SSADD remain_ename remain_ss) ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; (SETQ hrail_sscnt (1+ hrail_sscnt)) ;;; ) ;_ end of while ;;; (IF (AND remain_ss (> (SSLENGTH remain_ss) 0)) ;;; (PROGN (SETQ remain_sscnt (SSLENGTH remain_ss)) ;;; (WHILE (> remain_sscnt 0) ;;; (SETQ this_remain (ENTGET (SSNAME remain_ss (1- remain_sscnt)))) ;;; (IF (NOT (EQ (CDR (ASSOC 8 this_remain)) "0")) ;;; (PROGN (SETQ this_remain (SUBST (CONS 8 "0") (ASSOC 8 this_remain) this_remain)) ;;; (ENTMOD this_remain) ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF ;;; (SETQ remain_sscnt (1- remain_sscnt)) ;;; ) ;_ end of WHILE ;;; ;;; (COMMAND ".pedit" remain_ename "Y" "J" remain_ss "" "") ;;; ;;; (SETQ this_pline (ENTGET (ENTLAST))) ;;; ;;; (IF (EQ (CDR (ASSOC 0 this_pline)) "POLYLINE") ;;; ;;; (PROGN (SETQ this_vertex this_pline) ;;; ;;; (WHILE (NOT (EQ (CDR (ASSOC 0 this_vertex)) "SEQEND")) ;;; ;;; (SETQ this_vertex (ENTGET (ENTNEXT (CDR (ASSOC -1 this_vertex))))) ;;; ;;; (SETQ this_vertex (SUBST (CONS 8 "0") (ASSOC 8 this_vertex) this_vertex)) ;;; ;;; ;;; (PRINC "\n") ;;; ;;; ;;; (PRINC ;;; ;;; (ENTMOD this_vertex) ;;; ;;; ;;; ) ;;; ;;; ;;; (PRINC) ;;; ;;; ) ;_ end of WHILE ;;; ;;; (PRINC this_vertex) ;;; ;;; (ENTMOD this_pline) ;;; ;;; ) ;_ end of PROGN ;;; ;;; ) ;_ end of IF ;;; ;;; (SSADD (ENTLAST) hrail_ss) ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF (SETQ hr_cdate (GETVAR "cdate") grp_name1 (RTOS (FIX hr_cdate) 2 0) grp_name2 (RTOS (FIX (* 1000000 (REM hr_cdate (FIX hr_cdate)))) 2 0) grp_name (STRCAT "HRAIL_" grp_name1 grp_name2) grp_desc (STRCAT (RTOS rail_od 2 2) "\" Hand rail") ) ;_ end of SETQ (COMMAND "-group" "create" grp_name grp_desc hrail_ss "") (SETVAR "osmode" 0) (SETVAR "clayer" rail_layer) (IF (EQ do_hides "Yes") (PROGN (COMMAND ".-block" grp_name (CAR hr_pnt_lst) hrail_ss "") (COMMAND ".-insert" grp_name (CAR hr_pnt_lst) 1 1 0) (SETQ last_hrail (SSADD)) (SSADD (ENTLAST) last_hrail) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "osmode" old_hrail_osmode) ) ;_ end of PROGN ;;; (PROGN ;;; (PRINC "\nSome rail lines were not created! ") ;;; (PRINC) ;;; ) ;;; ) ) ;_ end of PROGN ) ;_ end of IF (IF (AND made_some_lines temp_ss) (PROGN (SETQ tempss_len (SSLENGTH temp_ss) tempss_cnt 0 ) ;_ end of setq (WHILE (< tempss_cnt tempss_len) (ENTDEL (SSNAME temp_ss tempss_cnt)) (SETQ tempss_cnt (1+ tempss_cnt)) ) ;_ end of while ) ;_ end of progn ) ;_ end of IF (c:rslayr) (c:hrupd) (IF (FINDFILE "1x1.bmp") (PROGN (IF (TBLOBJNAME "block" "hdcirc") nil (PROGN (PRINC "\nDrawing HDCIRC.DWG not found! Hiding corners disabled. ") (PRINC)) ) ;_ end of IF (IF (TBLOBJNAME "block" "hdbox") nil (PROGN (PRINC "\nDrawing HDBOX.DWG not found! Hiding handrail disabled. ") (PRINC)) ) ;_ end of IF ) ;_ end of PROGN (PROGN (PRINC "\nImage 1X1.BMP not found! Hiding handrail disabled. ") (PRINC)) ) ;_ end of IF (COMMAND ".undo" "end") (SETQ *error* old_hrail_error) (IF old_hrail_osmode (SETVAR "osmode" old_hrail_osmode) ) ;_ end of IF (PRINC) ) ;defun (DEFUN c:hrupd (/ handrail_ss) (SETQ oldcmdecho (GETVAR "cmdecho")) (SETVAR "cmdecho" 0) (SETQ handrail_ss (SSGET "x" '((2 . "HRAIL_*")))) ;;; (SETQ hdcirc_ss (SSGET "x" '((8 . "*RAIL?HAND-HIDE")))) ;;; (SETQ hrails_ss (SSGET "X" '((8 . "*RAIL?HAND")))) (IF handrail_ss ;(AND hrails_ss hdcirc_ss) (PROGN ;;; (COMMAND "imageframe" "off") ;;; (COMMAND "_.draworder" hdcirc_ss "" "f") ;;; (COMMAND "_.draworder" hrails_ss "" "f") ;;; (COMMAND "_.move" hdcirc_ss "" "0,0" "") (COMMAND "_.move" handrail_ss "" "0,0" "") (IF last_hrail (PROGN (COMMAND "_.draworder" last_hrail "" "f") (COMMAND "_.move" last_hrail "" "0,0" "") (SETQ last_hrail nil) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (PROGN (PRINC "\nNo handrail objects found! ") (PRINC)) ) ;_ end of IF (SETVAR "cmdecho" oldcmdecho) (PRINC) (PRINC) ) ;_ end of defun ;;;Setq debugpts T to enable placement of text at the points "bxp#" ;;; (IF debugpts ;;; (IF pttxt ;;; nil ;;; (LOAD "pttxt" "\nFile PTXT.LSP not loaded!") ;;; ) ;_ end of IF ;;; ) ;_ end of if ;;; (IF (AND debugpts pttxt) ;;; (PROGN (IF fthk ;;; nil ;;; (SETQ fthk 5.0) ;;; ) ;_ end of IF ;;; (pttxt "HDBOX_" "bxp" 1 5) ;;; ) ;_ end of PROGN ;;; ) ;_ end of if ;;;Use the above to graphically identify and debug the defined points. ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ;*** DO NOT add text below the comment! ***|;