;;;Creates LWPolyline with alternating long and short reversing arcs ;;;We use it for flexible cable symbology (as opposed to conduit) on electrical drawings. ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; http://paracadd.com ;;; All rights reserved. ;;; ;;; COPYRIGHT: 8/2/2007 ;;; EDITED: 8/2/2007 ;;; (DEFUN c:squig (/ start_it old_it this_ptlst) (SETQ bulge_lst nil) (IF dimscl nil (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ") ) ;_ end of if (dimscl) (SETQ start_it nil old_it nil this_ptlst nil ;;; this_dist (* 0.43 dimsc) ) ;_ end of SETQ (SETQ this_dist (ureal 1 "" "Pattern distance?" this_dist)) (WHILE (AND (SETQ it (GRREAD T 1 1)) (EQ (CAR it) 5)) (IF (AND old_it (> (DISTANCE (CADR old_it) (CADR it)) (IF (NOT this_ptlst) (* 0.883721 this_dist) this_dist ) ;_ end of IF ) ;_ end of > ) ;_ end of AND (PROGN (SETQ this_ptlst (APPEND this_ptlst (LIST (CADR it)))) (SETQ old_it it) (GRDRAW (CADR old_it) (CADR it) 2 1) ) ;_ end of progn (IF (NOT old_it) (PROGN (IF this_ptlst nil (SETQ this_ptlst (LIST (CADR it))) ) ;_ end of IF (PROGN (SETQ old_it it) (GRDRAW (CADR old_it) (CADR it) 2 1)) ) ;_ end of PROGN (SETQ last_it it) ) ;_ end of if ) ;_ end of if ) ;_ end of while (IF this_ptlst (PROGN (SETQ cnt 1 this_bulge 0.6 squig_ptlst nil ) ;_ end of SETQ (SETQ this_ptlst (REVERSE (APPEND (CDR last_it) (CDR (REVERSE this_ptlst))))) (WHILE (< cnt (LENGTH this_ptlst)) (seg_data (LIST (IF (NOT squig_ptlst) (NTH (1- cnt) this_ptlst) (POLAR (NTH (1- cnt) this_ptlst) (ANGLE (NTH (1- cnt) this_ptlst) (NTH cnt this_ptlst)) (* 0.116279 this_dist) ;(* 0.05 dimsc) ) ;_ end of POLAR ) ;_ end of IF (CONS 42 (- this_bulge)) ) ;_ end of LIST (POLAR (NTH cnt this_ptlst) (ANGLE (NTH cnt this_ptlst) (NTH (1- cnt) this_ptlst))(* 0.116279 this_dist)) ;(* 0.05 dimsc) ) ;_ end of seg_data (SETQ radpt_1 radpt tanpt_1 this_b arcrad1 arcrad ) ;_ end of SETQ (IF (< (1+ cnt) (LENGTH this_ptlst)) (PROGN (seg_data (LIST (POLAR (NTH cnt this_ptlst) (ANGLE (NTH cnt this_ptlst) (NTH (1+ cnt) this_ptlst))(* 0.116279 this_dist)) ;(* 0.05 dimsc) (CONS 42 (- this_bulge)) ) ;_ end of LIST (POLAR (NTH (1+ cnt) this_ptlst) (ANGLE (NTH (1+ cnt) this_ptlst) (NTH cnt this_ptlst)) (* 0.116279 this_dist) ;(* 0.05 dimsc) ) ;_ end of POLAR ) ;_ end of seg_data (SETQ radpt_2 radpt tanpt_2 (CAR this_a) arcrad2 arcrad ) ;_ end of SETQ (SETQ new_radpt (INTERS radpt_1 tanpt_1 radpt_2 tanpt_2 nil)) ;;; (ENTMAKE (LIST (CONS 0 "LINE") (CONS 8 "RADIUS_LINES") (CONS 10 radpt_1) (CONS 11 new_radpt))) ;_ end of ENTMAKE (SETQ base_ang (ANGLE tanpt_1 tanpt_2) seg_midpt (POLAR tanpt_1 (ANGLE tanpt_1 tanpt_2) (/ (DISTANCE tanpt_1 tanpt_2) 2.0)) arc_midpt (POLAR new_radpt (+ base_ang (* PI 0.5)) (DISTANCE tanpt_1 new_radpt) ) ;_ end of POLAR amid_ang (- (ANGLE tanpt_1 arc_midpt) base_ang) a_bulge (/(SIN(/ amid_ang 2.0))(COS(/ amid_ang 2.0))) ) ;_ end of SETQ ;;; (SETQ bulge_lst (APPEND bulge_lst (LIST a_bulge))) ) ;_ end of PROGN ) ;_ end of IF (SETQ squig_ptlst (APPEND squig_ptlst (LIST (CONS 10 (IF (NOT squig_ptlst) (NTH (1- cnt) this_ptlst) (POLAR (NTH (1- cnt) this_ptlst) (ANGLE (NTH (1- cnt) this_ptlst) (NTH cnt this_ptlst)) (* 0.116279 this_dist) ;(* 0.05 dimsc) ) ;_ end of POLAR ) ;_ end of IF ) ;_ end of CONS (CONS 40 0) (CONS 41 0) (CONS 42 this_bulge);(SETQ this_bulge (* -1 this_bulge))) (CONS 10 (IF (EQ (NTH cnt this_ptlst)(LAST this_ptlst)) (LAST this_ptlst) (POLAR (NTH cnt this_ptlst) (ANGLE (NTH cnt this_ptlst) (NTH (1- cnt) this_ptlst)) (* 0.116279 this_dist) ;(* 0.05 dimsc) ) ;_ end of POLAR ) ) ;_ end of CONS (CONS 40 0) (CONS 41 0) (CONS 42 (- a_bulge)) ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (ENTMAKE (APPEND (LIST (CONS 0 "lwpolyline") (CONS 100 "AcDbEntity") (CONS 100 "AcDbPolyline") (CONS 8 "E-CTRL2CABL") (CONS 70 0) (CONS 90 (FIX (/ (LENGTH squig_ptlst) 4.0))) ) ;_ end of list squig_ptlst ) ;_ end of APPEND ) ;_ end of ENTMAKE (SETQ layerltype "Continuous" layercolor "2" ) ;_ end of SETQ (IF layentmake nil (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ") ) ;_ end of IF (layentmake "E-CTRL2CABL" layercolor layerltype) (REDRAW) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of defun (DEFUN seg_data (a b /) ; 'a' is a list, a=((pline vertex point)(assoc 42 )) b=(next vertex point) ; seg_data sets the following variables from "point-bulge-point" (polyline style) arc definition: ; i_ang = included angle ; chordlen = chord length ; chordang = angle of chord a-b (2D - in XY plane) ; arcrad = radius ; radang = angle of radius from center point through midpoint of chord ; radpt = radius point ; seg_len = length of arc along circumference ; tan_ang = angle to subtract from chord angle to calculate tangent angle ;;; (princ "\na = ") ;;; (princ a) ;;; (princ) (SETQ this_a a this_b b i_ang (* 4.0 (ATAN (CDADR a))) chordlen (DISTANCE (LIST (CAAR a) (CADAR a)) (LIST (CAR b) (CADR b))) chordang (ANGLE (LIST (CAAR a) (CADAR a)) (LIST (CAR b) (CADR b))) arcrad (IF (OR (ZEROP chordlen) ; [(4 b-squared) + (c-squared)]/8b = radius (ZEROP (CDADR a)) ) ;_ end of OR nil (/ (+ (* 4 (/ (* chordlen (CDADR a)) 2) ; b squared (/ (* chordlen (CDADR a)) 2) ; b is perpindicular height of arc from center of chord ) ;_ end of * (* chordlen chordlen) ; c squared; c is the chord length ) ;_ end of + (* 8 (/ (* chordlen (CDADR a)) 2)) ; 8b ) ;_ end of / ) ;_ end of IF radang (IF (ZEROP (CDADR a)) ;angle to radpt nil (+ (- chordang (* (ATAN (CDADR a)) 2)) (/ PI 2)) ) ;_ end of IF radpt (IF (ZEROP (CDADR a)) nil (POLAR (CAR a) radang arcrad) ) ;_ end of IF seg_len (IF arcrad (* i_ang arcrad) chordlen ) ;_ end of IF tan_ang (* 2.0 (ATAN (CDR (ASSOC 42 a)))) ) ;_ end of setq (IF debug_ang (PROGN (PRINC "\n") ;;; (PRINC (STRCAT (RTOS (CAAR a) 2 4)","(RTOS (CADAR a) 2 4)",0.0")) (PRINC " tan_ang=") (PRINC tan_ang) (PRINC " (") (PRINC (* 180.0 (/ tan_ang PI))) (PRINC "°) ") ;;; (PRINC (STRCAT (RTOS (CAR b) 2 4)","(RTOS (CADR b) 2 4)",0.0")) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ;;;Draw radius lines for arc segments (IF showradlines (IF radpt (PROGN (ENTMAKE (LIST (CONS 0 "LINE") (CONS 8 "RADIUS_LINES") (CONS 10 (CAR a)) (CONS 11 radpt))) ;_ end of ENTMAKE ;;; (ENTMAKE (LIST (CONS 0 "LINE") ;;; (CONS 8 "RADIUS_LINES") ;;; (CONS 10 b) ;;; (CONS 11 radpt) ;;; ) ;_ end of LIST ;;; ) ;_ end of ENTMAKE ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (EVAL seg_len) ) ;_ end of DEFUN (defun c:rsquig ( / squig_ss) (SETQ squig_ss (ssget '((0 . "LWPOLYLINE"))));(8 . "E-CTRL2CABL")))) (IF squig_ss (PROGN (SETQ squig_cnt 0 squig_len (SSLENGTH squig_ss) ) (WHILE (< squig_cnt squig_len) (setq this_squig (ENTGET (SSNAME squig_ss squig_cnt)) this_rsquig NIL ) (foreach n this_squig (SETQ this_rsquig (IF (EQ (CAR n) 42) (APPEND this_rsquig (LIST (CONS 42 (* -1(CDR n))))) (APPEND this_rsquig (LIST n)) ) ) ) (ENTMOD this_rsquig) (setq squig_cnt (1+ squig_cnt)) ) ) ) (PRINC) ) ;;;**************************************************************************** ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 1 nil nil nil nil T) ;*** DO NOT add text below the comment! ***|;