;;;Place a custom linetype as an anonymous block. (I call it chain) ;;;The block entity is not placed in ;;;the drawing until the user terminates the input with a return ;;;supplied to the "next point" prompt. ;;; ;;; AUTHOR: ;;; HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 6-7-95 ;;; Edited: 07-10-2009 ;;; (DEFUN c:chain (/ arcb fensta clspt fpt chrdl strtl clclf count fpt1 fpt2 fpt3 fpt4 fpt5 arcs arcc fltot part1 ) (SETQ ;chain_osmod (GETVAR "osmode") fltot 0 ) ;_ end of setq ;;; (SETVAR "osmode" 0) (ENTMAKE) (IF dimscl nil (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ") ) ;_ end of IF (IF upoint nil (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of if (IF ureal nil (LOAD "ureal" "\nFile UREAL.LSP not loaded! ") ) ;_ end of if (dimscl) (SETQ aorln " ") (COND ((EQ modf "EXST") (SETQ cirad 0.625) ;(* dimsc 0.03125)) (SETQ fensta "Existing") ) ((NOT (EQ modf "EXST")) (SETQ cirad 0.625) ;(* dimsc 0.0469)) (SETQ fensta "Proposed") ) ) ;cond (SETQ this_blk_name (STRCAT "2-inch-chain-" (RTOS (GETVAR "CDATE") 2 4)) ) ;_ end of SETQ (SETQ part1 (ENTMAKE (LIST (CONS 0 "BLOCK") (CONS 70 3) (CONS 2 "*U") (CONS 10 (LIST 0 0 0)) ) ;_ end of list ) ;_ end of entmake ) ;_ end of SETQ (WHILE (NOT fpt1) (SETQ fpt (upoint 0 "" (STRCAT fensta " chain" aorln) nil nil) ) ;_ end of setq (SETQ blockinsertionpoint fpt fpt1 (LIST 0 0 0) clspt fpt1 strtl 1 oldfpt2 fpt ) ;_ end of setq ) ;_ end of WHILE (WHILE (AND (NOT clclf) (IF (OR (NOT fpt2) (< strtl 3)) (PROGN (SETQ strtl (1+ strtl)) (SETQ fpt2 (upoint 0 "" (STRCAT fensta " chain ") nil oldfpt2 ) ;_ end of upoint ) ;_ end of setq ) ;progn (SETQ fpt2 (upoint 0 "" (STRCAT fensta " chain ") nil oldfpt2 ) ;_ end of upoint ) ;_ end of setq ) ;if ) ;and (SETQ oldfpt2 fpt2 fpt2 (LIST (- (CAR fpt2)(CAR blockinsertionpoint))(- (CADR fpt2)(CADR blockinsertionpoint))(- (CADDR fpt2)(CADDR blockinsertionpoint))) langl (ANGLE fpt1 fpt2) fenl (DISTANCE fpt1 fpt2) count (1+ (FIX (/ fenl 1.75))) ;(* dimsc 0.5)))) cispc (/ fenl count) fpt1 (POLAR fpt1 (+ langl PI) 0.75) ) ;setq (WHILE (> count 0) (SETQ langl (ANGLE fpt1 fpt2) fpt3 (POLAR fpt1 langl 0.75) ;(* dimsc 0.0625)) fpt4 (POLAR fpt1 langl 1.75) ;cispc fpt6 (POLAR fpt4 (+ langl PI) 0.375) ;cispc fpt8 (POLAR fpt4 langl 0.375) ;cispc fpt5 (POLAR fpt3 langl 2.0) ;(* dimsc 0.0625)) ) ;setq (IF (> (DISTANCE fpt1 fpt2) (DISTANCE fpt1 fpt5)) (IF (EQ (REM count 2) 0) (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) (SETQ oldfpt5 fpt5) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (IF (EQ (REM count 2) 1) (IF (> (DISTANCE fpt1 fpt2) (MAX (DISTANCE fpt1 (POLAR fpt6 langl cirad)) (DISTANCE fpt1 (POLAR fpt8 langl cirad)) ) ;_ end of MAX ) ;_ end of > (PROGN (ENTMAKE (LIST (CONS 0 "ARC") (CONS 10 fpt6) (CONS 8 "0") (CONS 40 cirad) (CONS 50 (+ langl (/ PI 2.0))) (CONS 51 (- langl (/ PI 2.0))) ) ;_ end of list ) ;_ end of entmake (ENTMAKE (LIST (CONS 0 "ARC") (CONS 10 fpt8) (CONS 8 "0") (CONS 40 cirad) (CONS 50 (- langl (/ PI 2.0))) (CONS 51 (+ langl (/ PI 2.0))) ) ;_ end of list ) ;_ end of entmake (ENTMAKE (LIST (CONS 0 "LINE") (CONS 10 (POLAR fpt6 (+ langl (/ PI 2.0)) cirad)) (CONS 11 (POLAR fpt8 (+ langl (/ PI 2.0)) cirad)) (CONS 8 "0") ) ;_ end of list ) ;_ end of entmake (ENTMAKE (LIST (CONS 0 "LINE") (CONS 10 (POLAR fpt6 (- langl (/ PI 2.0)) cirad)) (CONS 11 (POLAR fpt8 (- langl (/ PI 2.0)) cirad)) (CONS 8 "0") ) ;_ end of list ) ;_ end of entmake (SETQ oldfpt8 fpt8) ) ;_ end of PROGN (ENTMAKE (LIST (CONS 0 "LINE") (CONS 10 (IF (< (DISTANCE (POLAR oldfpt8 langl (- cirad 0.25)) fpt2) (DISTANCE oldfpt5 fpt2) ) ;_ end of < (POLAR oldfpt8 langl (- cirad 0.25)) oldfpt5 ) ;_ end of IF ) ;_ end of CONS (CONS 11 fpt2) (CONS 8 "0") ) ;_ end of list ) ;_ end of entmake ) ;_ end of IF ) ;_ end of IF (SETQ fpt1 fpt4 ;(POLAR fpt4 langl 0.25) count (1- count) ) ;setq ) ;while (SETQ arcc nil arcs nil arcm nil ) ;_ end of setq (SETQ fltot (+ fltot fenl) ;oldfpt2 fpt2 ) ;_ end of SETQ ) ;while (ENTMAKE (LIST (CONS 0 "ATTDEF") (CONS 10 clspt) (CONS 11 clspt) (CONS 40 (* 0.110 dimsc)) (CONS 41 1.0) (CONS 50 0.0) (CONS 1 (RTOS fltot 2 3)) (CONS 3 (STRCAT (RTOS fltot 2 3) " Chain: ")) (CONS 2 (STRCAT (RTOS fltot 2 3) "_CHAIN:")) (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) " inches of chain added ")) (ENTMAKE (LIST (CONS 0 "INSERT") (CONS 2 nblk) (CONS 10 blockinsertionpoint) (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) "_IN_CHAIN:")) (CONS 70 1) ) ;list ) ;entmake (ENTMAKE (LIST (CONS 0 "SEQEND") ) ;list ) ;entmake ; (SETVAR "osmode" chain_osmod) (SETQ arcb nil) (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!***|;