;;;Place a custom linetype as an anonymous block. (I call it chain-link fence) ;;;It allows linear as well as curved sections. The user toggles ;;;between the two during placement. The block entity is not placed in ;;;the drawing until the user terminates the input with a return ;;;supplied to the "next point" prompt. Size of the graphic elements ;;;is determined by the dimscale. If the user matches the dimscale ;;;with the drawing scale the graphics will scale the same on all ;;;drawings. The linetype consists of equally spaced circles (nearest ;;;to 1/2" spacing at scale for the length of arc or line) and lines ;;;between them that do not touch. If the variable modf = "EXST" the ;;;circle radius is 0.03125 x dimscale, if not it is 0.0469 x dimscale. ;;; ;;; AUTHOR: ;;; HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 6-7-95 ;;; Edited: 11-24-98 ;;; (DEFUN c:clfen (/ arcb fensta clspt fpt chrdl strtl clclf count fpt1 fpt2 fpt3 fpt4 fpt5 arcs arcc fltot ) (SETQ osmod (GETVAR "osmode") fltot 0 ) ;_ end of setq (SETVAR "osmode" 0) (ENTMAKE (LIST (CONS 0 "endblk"))) (IF dimscl nil (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ")) (if upoint nil (load"upoint" "\nFile UPOINT.LSP not loaded! ")) (if ureal nil (load"ureal" "\nFile UREAL.LSP not loaded! ")) (dimscl) (SETQ aorln " Arc/") (COND ((EQ modf "EXST") (SETQ cirad (* dimsc 0.03125)) (SETQ fensta "Existing") ) ((NOT (EQ modf "EXST")) (SETQ cirad (* dimsc 0.0469)) (SETQ fensta "Proposed") ) ) ;cond (ENTMAKE (LIST (CONS 0 "BLOCK") (CONS 70 3) (CONS 2 "*U") (CONS 10 (LIST 0 0 0)) ) ;_ end of list ) ;_ end of entmake (WHILE (NOT fpt1) (SETQ fpt (upoint 0 "Arc Line" (STRCAT fensta " fence" aorln) nil nil) ) ;_ end of setq (COND ((EQ fpt "Arc") (SETQ aorln " Line/") ) ((EQ fpt "Line") (SETQ aorln " Arc/") ) (fpt (SETQ fpt1 fpt clspt fpt1 strtl 1 ) ;_ end of setq ) ) ;cond ) ;while (ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 8 "0") (CONS 10 fpt1) (CONS 40 cirad) ) ;_ end of list ) ;_ end of entmake (WHILE (AND (NOT clclf) (IF (EQ fpt "Arc") (SETQ fpt2 (upoint 0 "Close" (STRCAT fensta " fence Close/") nil fpt1 ) ;_ end of upoint ) ;_ end of setq (IF (OR (NOT fpt2) (< strtl 3)) (PROGN (SETQ strtl (1+ strtl)) (SETQ fpt2 (upoint 0 "Arc" (STRCAT fensta " fence Arc/") nil fpt1 ) ;_ end of upoint ) ;_ end of setq ) ;progn (SETQ fpt2 (upoint 0 "Arc Close" (STRCAT fensta " fence Arc/Close/") nil fpt1 ) ;_ end of upoint ) ;_ end of setq ) ;if ) ;if ) ;and (IF (EQ fpt2 "Close") (SETQ fpt2 clspt clclf T ) ;_ end of setq ) ;if (IF (OR (EQ fpt2 "Arc") (EQ fpt "Arc") ) ;or (PROGN (COND ((EQ fpt "Arc") (SETQ chrdl (DISTANCE fpt1 fpt2)) (bulge) ) ) ;cond (IF (EQ fpt2 "Arc") (PROGN (IF clclf nil (SETQ fpt2 (upoint 0 "Close" (STRCAT fensta " fence Close/") nil fpt1 ) ;_ end of upoint ) ;_ end of setq ) ;if (IF (EQ fpt2 "Close") (SETQ fpt2 clspt clclf T ) ;_ end of setq ) ;if (SETQ chrdl (DISTANCE fpt1 fpt2)) (bulge) (WHILE (>= chrdl (* arcr 2)) (PROGN (PRINC (STRCAT "\nChord length greater than or equal to 2r <" (RTOS (/ chrdl 2)) " min.>" ) ;_ end of strcat ) ;_ end of princ (SETQ arcr nil) (bulge) ) ;progn ) ;while (SETQ fpt "Arc") ) ;progn ) ;if (IF (EQ fpt2 "Close") (SETQ fpt2 clspt clclf T ) ;_ end of setq ) ;if (SETQ chrdl (DISTANCE fpt1 fpt2)) (bulge) (WHILE (>= chrdl (* arcr 2)) (PROGN (PRINC (STRCAT "\nChord length greater than or equal to 2r <" (RTOS (/ chrdl 2)) " min.>" ) ;_ end of strcat ) ;_ end of princ (SETQ arcl nil) (bulge) ) ;progn ) ;while (PROGN (SETQ incla (* (ATAN (/ chrdl (* 2 arcr)) (SQRT (- 1 (* (/ chrdl (* 2 arcr)) (/ chrdl (* 2 arcr))) ) ;_ end of - ) ;_ end of sqrt ) ;_ end of atan 2 ) ;_ end of * oangs (/ (- PI incla) 2) langl (ANGLE fpt1 fpt2) lpt (POLAR fpt1 (+ langl oangs) arcr) rpt (POLAR fpt1 (- langl oangs) arcr) ) ;setq (IF (OR (AND (< (DISTANCE lpt arcc) (DISTANCE rpt arcc)) (< (DISTANCE lpt arcs) (DISTANCE rpt arcs)) ) ;and (AND (> (DISTANCE lpt arcc) (DISTANCE rpt arcc)) (> (DISTANCE lpt arcs) (DISTANCE rpt arcs)) ) ;and ) ;or (SETQ incla (- (+ PI PI) incla)) ) ;if (SETQ fenl (* incla arcr) count (1+ (FIX (/ fenl (* dimsc 0.5)))) incrn (1- count) ) ;setq (WHILE (> count 0) (IF (< (DISTANCE lpt arcc) (DISTANCE rpt arcc)) (IF (< (DISTANCE lpt arcs) (DISTANCE rpt arcs)) (SETQ ipt lpt incra (+ (ANGLE ipt fpt2) (* (/ incla incrn) (1- count)) ) ;_ end of + fpt4 (POLAR ipt incra arcr) fpt3 (POLAR fpt1 (ANGLE fpt1 fpt4) (* dimsc 0.0625)) fpt5 (POLAR fpt4 (+ (ANGLE fpt1 fpt4) PI) (* dimsc 0.0625) ) ;_ end of polar ) ;setq (SETQ ipt lpt incra (- (ANGLE ipt fpt2) (* (/ incla incrn) (1- count)) ) ;_ end of - fpt4 (POLAR ipt incra arcr) fpt3 (POLAR fpt1 (ANGLE fpt1 fpt4) (* dimsc 0.0625)) fpt5 (POLAR fpt4 (+ (ANGLE fpt1 fpt4) PI) (* dimsc 0.0625) ) ;_ end of polar ) ;setq ) ;if (IF (> (DISTANCE lpt arcs) (DISTANCE rpt arcs)) (SETQ ipt rpt incra (- (ANGLE ipt fpt2) (* (/ incla incrn) (1- count)) ) ;_ end of - fpt4 (POLAR ipt incra arcr) fpt3 (POLAR fpt1 (ANGLE fpt1 fpt4) (* dimsc 0.0625)) fpt5 (POLAR fpt4 (+ (ANGLE fpt1 fpt4) PI) (* dimsc 0.0625) ) ;_ end of polar ) ;setq (SETQ ipt rpt incra (+ (ANGLE ipt fpt2) (* (/ incla incrn) (1- count)) ) ;_ end of + fpt4 (POLAR ipt incra arcr) fpt3 (POLAR fpt1 (ANGLE fpt1 fpt4) (* dimsc 0.0625)) fpt5 (POLAR fpt4 (+ (ANGLE fpt1 fpt4) PI) (* dimsc 0.0625) ) ;_ end of polar ) ;setq ) ;if ) ;if (IF (EQ (1- count) incrn) nil (PROGN (ENTMAKE (LIST (CONS 0 "LINE") (CONS 10 fpt3) (CONS 11 fpt5) (CONS 8 "0") ) ;_ end of list ) ;_ end of entmake (GRDRAW fpt3 fpt5 7) ) ;progn ) ;if (ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 fpt4) (CONS 8 "0") (CONS 40 cirad) ) ;_ end of list ) ;_ end of entmake (SETQ fpt1 fpt4 count (1- count) ) ;setq (SETQ fpt nil) ) ;while ) ;progn ) ;progn (PROGN (SETQ fenl (DISTANCE fpt1 fpt2) count (1+ (FIX (/ fenl (* dimsc 0.5)))) cispc (/ fenl count) ) ;setq (WHILE (> count 0) (SETQ langl (ANGLE fpt1 fpt2) fpt3 (POLAR fpt1 langl (* dimsc 0.0625)) fpt4 (POLAR fpt1 langl cispc) fpt5 (POLAR fpt4 (+ langl PI) (* dimsc 0.0625)) ) ;setq (ENTMAKE (LIST (CONS 0 "LINE") (CONS 10 fpt3) (CONS 11 fpt5) (CONS 8 "0") ) ;_ end of list ) ;_ end of entmake (GRDRAW fpt3 fpt5 7) (ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 fpt4) (CONS 8 "0") (CONS 40 cirad) ) ;_ end of list ) ;_ end of entmake (SETQ fpt1 fpt4 count (1- count) ) ;setq ) ;while ) ;progn ) ;if (SETQ arcc nil arcs nil arcm nil ) ;_ end of setq (SETQ fltot (+ fltot fenl)) ) ;while (ENTMAKE (LIST (CONS 0 "ATTDEF") (CONS 10 clspt) (CONS 40 (* 0.110 dimsc)) (CONS 1 (RTOS fltot)) (CONS 3 (STRCAT (RTOS fltot) " LF Fence: ")) (CONS 2 (STRCAT (RTOS fltot) "_LF_FENCE:")) (CONS 70 1) ) ;list ) ;entmake (SETQ nblk (ENTMAKE (LIST (CONS 0 "endblk")))) (PRINC (STRCAT "\nBlock " (IF nblk nblk "NOT" ) ;_ end of if " Made\n" ) ;_ end of strcat ) ;_ end of princ (PRINC (STRCAT "\n" (RTOS fltot) " LF of fence added ")) (ENTMAKE (LIST (CONS 0 "INSERT") (CONS 2 nblk) (CONS 10 (LIST 0 0 0)) (CONS 8 (GETVAR "clayer")) (CONS 66 1) ) ;_ end of list ) ;_ end of entmake (ENTMAKE (LIST (CONS 0 "ATTRIB") (CONS 10 clspt) (CONS 40 (* 0.110 dimsc)) (CONS 1 (RTOS fltot)) (CONS 2 (STRCAT (RTOS fltot) "_LF_FENCE:")) (CONS 70 1) ) ;list ) ;entmake (ENTMAKE (LIST (CONS 0 "SEQEND") ) ;list ) ;entmake (SETVAR "osmode" osmod) (SETQ arcb nil) (PRINC) ) ;defun ;******** (DEFUN bulge (/) (IF (EQ arcm "Bulge") (PROGN (IF (AND fpt2 chrdl arcs) nil (PROGN (SETQ arcb (ureal 1 "Radius" "Arc Radius/" (IF arcb arcb nil ) ;_ end of if ) ;_ end of ureal ) ;_ end of setq (IF (EQ arcb "Radius") (PROGN (SETQ arcm nil arcb nil ) ;_ end of setq (bulge) ) ;progn (PROGN (COND ((NOT fpt2) (SETQ fpt2 (upoint 0 "Close" (STRCAT fensta " fence Close/" ) ;_ end of strcat nil fpt1 ) ;_ end of upoint ) ;_ end of setq (IF (EQ fpt2 "Close") (SETQ fpt2 clspt clclf T ) ;_ end of setq ) ;_ end of if ) ;if ;not ) ;cond (SETQ chrdl (DISTANCE fpt1 fpt2)) (SETQ arcr (/ (* chrdl (SIN (- (ATAN (/ chrdl 2) arcb) (ATAN (/ arcb (/ chrdl 2))) ) ;_ end of - ) ;_ end of sin ) ;_ end of * (SIN (* 2 (- PI (* 2 (ATAN (/ chrdl 2) arcb))))) ) ;_ end of / ) ;setq (SETQ arcs (upoint 1 "" "Pick side for arc" nil nil)) (IF (< (DISTANCE lpt arcs) (DISTANCE rpt arcs)) (SETQ arcc rpt) (SETQ arcc lpt) ) ;if ) ;progn ) ;if ) ;progn ) ;if ) ;progn (IF (OR (NOT arcc) (NOT arcs) (NOT arcr)) (PROGN (SETQ arcm (ureal 1 "Bulge" "Arc Bulge/" (IF arcr arcr nil ) ;_ end of if ) ;_ end of ureal ) ;_ end of setq (IF (EQ arcm "Bulge") (bulge) (PROGN (SETQ arcr arcm arcm nil ) ;_ end of setq (SETQ arcc (upoint 1 "" "Pick side for arc center" nil nil)) (SETQ arcs (upoint 1 "" "Pick side for arc" nil nil)) ) ;progn ) ;if ) ;progn ) ;if ) ;if (PRINC) ) ;defun ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ***Don't add text below the comment!***|;