;;;Draws an ARC (semicircle) on either side of any line or polyline intersection and trims the line inside the arc.
;;;
;;;Entity definitions are currently stored in variables in anticipation of future code making use of
;;;ENTMAKE, ENTMOD, and/or ENTUPD rather than the TRIM command. Once written, the code will eliminate arc
;;;creation (except at lines) and the use of the TRIM command and its occasional trim errors (wrong entity trimmed).
;;;
;;;The number of crossing Lines, Polylines, or LWPolylines has been arbitrarily limited to 6. More than 4 increases
;;;the possibility of trimming the wrong line.
;;;
;;; Author: Henry C. Francis
;;; 425 N. Ashe St.
;;; Southern Pines, NC 28387
;;; http://www.paracadd.com
;;; All rights reserved.
;;;
;;; COPYRIGHT: 5/3/2010
;;; EDITED: 5/3/2010
;;;
;;; Required subroutines: dimscl.lsp, ureal.lsp, upoint.lsp, ukword.lsp
;;;
;;;****************************************************************************
(DEFUN pick_inters_error (msg /)
(IF (EQ msg "Function cancelled")
(PRINC "\nLinejump cancelled ")
(PROGN (PRINC "\nCommand LINEJUMP abborted on error: ") (PRINC msg))
) ;_ end of IF
(SETQ *error* old_pick_inters_error)
(SETVAR "CELTYPE" pick_inters_celtype)
(SETVAR "CECOLOR" pick_inters_cecolor)
(SETVAR "osmode" pick_inters_osmode)
(SETVAR "pickbox" pick_inters_pickbox)
(SETVAR "aperture" pick_inters_aperture)
(PRINC)
) ;_ end of DEFUN
;;;****************************************************************************
(DEFUN c:linejump ()
(SETQ pick_inters nil
inters_ss nil
) ;_ end of SETQ
(SETQ old_pick_inters_error *error*
*error* pick_inters_error
) ;_ end of SETQ
(SETQ pick_inters_celtype (GETVAR "celtype"))
(SETQ pick_inters_cecolor (GETVAR "cecolor"))
(SETQ pick_inters_osmode (GETVAR "osmode"))
(SETQ pick_inters_pickbox (GETVAR "pickbox"))
(SETQ pick_inters_aperture (GETVAR "aperture"))
(SETVAR "CELTYPE" "BYLAYER")
(SETVAR "CECOLOR" "BYLAYER")
(SETVAR "osmode" 2080)
(IF dimscl
nil
(LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ")
) ;_ end of IF
(dimscl)
(IF ureal
nil
(LOAD "ureal" "\nFile UREAL.LSP not loaded! ")
) ;_ end of IF
(IF ukword
nil
(LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
) ;_ end of IF
(SETQ plotted_rad
(ureal 1
""
(STRCAT "Arc radius ("
(RTOS dimsc 2 1)
" scale R"
(RTOS (IF plotted_rad
plotted_rad
0.0625
) ;_ end of IF
2
4
) ;_ end of RTOS
"("
(RTOS (IF plotted_rad
plotted_rad
0.0625
) ;_ end of IF
5
4
) ;_ end of RTOS
"\")="
(RTOS (IF plotted_rad
(* plotted_rad dimsc)
(* 0.0625 dimsc)
) ;_ end of IF
2
3
) ;_ end of RTOS
" drawing units)"
) ;_ end of STRCAT
(IF plotted_rad
plotted_rad
0.0625
) ;_ end of IF
) ;_ end of ureal
) ;_ end of SETQ
(SETQ jump_rad (* dimsc plotted_rad))
(IF upoint
nil
(LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
) ;_ end of IF
;;; (WHILE (AND
(SETQ pick_inters (upoint 0 "Quit" "Pick intersection of lines or [Quit]" nil nil))
(/= pick_inters "Quit")
;;; ) ;_ end of AND
(IF (AND pick_inters (/= pick_inters "Quit"))
(PROGN
(COMMAND ".undo" "begin")
(SETQ pt1 (POLAR pick_inters 0 jump_rad) ;(* 0.01 dimsc)
pt2 (POLAR pick_inters (* PI 0.5) jump_rad) ;(* 0.01 dimsc)
pt3 (POLAR pick_inters PI jump_rad) ;(* 0.01 dimsc)
pt4 (POLAR pick_inters (* PI 1.5) jump_rad) ;(* 0.01 dimsc)
) ;_ end of SETQ
(SETQ inters_ss (SSGET "CP"
(LIST pt1 pt2 pt3 pt4)
'((-4 . ""))
) ;_ end of SSGET
) ;_ end of SETQ
(IF (AND inters_ss (< (SSLENGTH inters_ss) 5));arbitrary limit on the selection set size is 4
(PROGN
(SETQ inters_cnt 0
inters_ang_lst nil
) ;_ end of SETQ
(WHILE (< inters_cnt (SSLENGTH inters_ss))
(SETQ inters_ent (ENTGET (SSNAME inters_ss inters_cnt)))
(COND
((EQ (CDR (ASSOC 0 inters_ent)) "POLYLINE")
(SETQ prev_ent nil)
(WHILE (AND (SETQ inters_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 inters_ent)))))
(/= (CDR (ASSOC 0 inters_ent)) "SEQEND")
) ;_ end of AND
(IF (AND prev_ent
;Find the selected VERTEX
;The distance and angle to next vertex will match:
;sum of distances from intersection point to each; and,
;angle from intersection point to next vertex
(EQUAL (DISTANCE (CDR (ASSOC 10 inters_ent)) (CDR (ASSOC 10 prev_ent)))
(+ (DISTANCE pick_inters (CDR (ASSOC 10 inters_ent)))
(DISTANCE pick_inters (CDR (ASSOC 10 prev_ent)))
) ;_ end of +
0.01
) ;_ end of EQUAL
(EQUAL (ANGLE pick_inters (CDR (ASSOC 10 prev_ent)))
(ANGLE (CDR (ASSOC 10 inters_ent)) (CDR (ASSOC 10 prev_ent)))
0.001
) ;_ end of EQUAL
) ;_ end of AND
(SETQ inters_ang_lst
(APPEND inters_ang_lst
(LIST (LIST (ANGLE (CDR (ASSOC 10 prev_ent))
(CDR (ASSOC 10 inters_ent))
) ;_ end of ANGLE
prev_ent
;The beginning VERTEX entity is stored for use with ENTMAKE and ENTDEL code
;which is yet to be written. Once written, arc creation and the command line use of TRIM
;will be unnecessary and the occasional trim errors (wrong entity trimmed) will be eliminated.
;The new VERTEX bulge of 1.0 or -1.0 must be determined by the direction of the Polyline and
;the side on which the arc segment will be.
;Code should account for an existing VERTEX that has a bulge already.
) ;_ end of LIST
) ;_ end of LIST
) ;_ end of APPEND
) ;_ end of SETQ
) ;_ end of IF
(SETQ prev_ent inters_ent)
) ;_ end of WHILE
)
((EQ (CDR (ASSOC 0 inters_ent)) "LWPOLYLINE")
(SETQ prev_ent (MEMBER (ASSOC 10 inters_ent) inters_ent))
(WHILE (AND (SETQ pnt_1 (LIST (NTH 0 prev_ent)(NTH 1 prev_ent)(NTH 2 prev_ent)(NTH 3 prev_ent)))
(ASSOC 10 (CDR prev_ent))
(SETQ prev_ent (MEMBER (ASSOC 10 (CDR prev_ent)) prev_ent))
(SETQ pnt_2 (LIST (NTH 0 prev_ent)(NTH 1 prev_ent)(NTH 2 prev_ent)(NTH 3 prev_ent)))
) ;_ end of AND
(IF (AND ;Find the selected LWPOLYLINE segment
;The distance and angle from pnt_1 to pnt_2 will match:
;the sum of distances from intersection point to pnt_1 and pnt_2; and,
;the angle from intersection point to pnt_2
(EQUAL (DISTANCE (CDAR pnt_1) (CDAR pnt_2))
(+ (DISTANCE pick_inters (CDAR pnt_1))
(DISTANCE pick_inters (CDAR pnt_2))
) ;_ end of +
0.01
) ;_ end of EQUAL
(EQUAL (ANGLE pick_inters (CDAR pnt_2))
(ANGLE (CDAR pnt_1) (CDAR pnt_2))
0.001
) ;_ end of EQUAL
) ;_ end of AND
(SETQ inters_ang_lst
(APPEND inters_ang_lst
(LIST (LIST (ANGLE (CDAR pnt_1)
(CDAR pnt_2)
) ;_ end of ANGLE
inters_ent
;The original LWPOLYLINE entity is stored for use with ENTMOD and ENTUPD code
;which is yet to be written. Once written, arc creation and the command line use of TRIM
;will be unnecessary and the occasional trim errors (wrong entity trimmed) will be eliminated.
;The new vertex bulge of 1.0 or -1.0 must be determined by the direction of the LWPolyline and
;the side on which the arc segment will be.
;Code should account for an existing vertex that has a bulge already.
) ;_ end of LIST
) ;_ end of LIST
) ;_ end of APPEND
) ;_ end of SETQ
) ;_ end of IF
) ;_ end of WHILE
)
((EQ (CDR (ASSOC 0 inters_ent)) "LINE")
(IF (EQUAL (ANGLE pick_inters (CDR (ASSOC 11 inters_ent)))
(ANGLE (CDR (ASSOC 10 inters_ent)) (CDR (ASSOC 11 inters_ent)))
0.001
) ;_ end of EQUAL
(SETQ inters_ang_lst
(APPEND inters_ang_lst
(LIST (LIST (ANGLE (CDR (ASSOC 10 inters_ent))
(CDR (ASSOC 11 inters_ent))
) ;_ end of ANGLE
inters_ent
;The original LINE entity is stored for use with ENTMAKE, ENTMOD and ENTUPD code
;which is yet to be written. Once written, the command line use of TRIM will be
;unnecessary and the occasional trim errors (wrong entity trimmed) will be eliminated
) ;_ end of LIST
) ;_ end of LIST
) ;_ end of APPEND
) ;_ end of SETQ
) ;_ end of IF
)
) ;_ end of COND
(SETQ inters_cnt (1+ inters_cnt))
) ;_ end of WHILE
(SETQ use_arc "No")
(FOREACH n inters_ang_lst
(IF (EQ use_arc "Yes")
nil
(PROGN (SETQ this_arc
(ENTMAKE
(APPEND
(LIST (CONS 0 "ARC")
(CONS 10 pick_inters)
(CONS 40 jump_rad)
(CONS 50 (CAR n))
(CONS 51
(IF (>= (CAR n) PI)
(- (CAR n) PI)
(+ PI (CAR n))
) ;_ end of IF
) ;_ end of CONS
) ;_ end of LIST
(COND
((AND (ASSOC 6 (CADR n)) (ASSOC 62 (CADR n)))
(LIST (ASSOC 8 (CADR n)) (ASSOC 6 (CADR n)) (ASSOC 62 (CADR n)))
)
((ASSOC 6 (CADR n))
(LIST (ASSOC 8 (CADR n)) (ASSOC 6 (CADR n)))
)
((ASSOC 62 (CADR n))
(LIST (ASSOC 8 (CADR n)) (ASSOC 62 (CADR n)))
)
(T (LIST (ASSOC 8 (CADR n))))
) ;_ end of COND
) ;_ end of APPEND
) ;_ end of ENTMAKE
) ;_ end of SETQ
(SETQ use_arc (ukword 1 "Yes No" "Use this arc? " "No"))
(IF (EQ use_arc "Yes")
(PROGN (SETQ used_arc this_arc)
;;; (SETVAR "pickbox" 1)
;;; (SETVAR "aperture" 1)
(COMMAND ".trim"
(ENTLAST)
""
pause
;;; (POLAR pick_inters (CAR n) (/ jump_rad 8.0))
;;; (POLAR pick_inters (+ (CAR n) PI) (/ jump_rad 8.0))
;;; (POLAR pick_inters (CAR n) (/ jump_rad 1.1))
;;; (POLAR pick_inters (+ (CAR n) PI) (/ jump_rad 1.1))
""
) ;_ end of COMMAND
;;; (SETVAR "pickbox" pick_inters_pickbox)
;;; (SETVAR "aperture" pick_inters_aperture)
) ;_ end of PROGN
(ENTDEL (ENTLAST))
) ;_ end of IF
(IF (EQ use_arc "Yes")
nil
(PROGN (SETQ
this_arc (ENTMAKE
(APPEND (LIST (CONS 0 "ARC")
(CONS 10 pick_inters)
(CONS 40 jump_rad)
(CONS 50
(IF (>= (CAR n) PI)
(- (CAR n) PI)
(+ PI (CAR n))
) ;_ end of IF
) ;_ end of CONS
(CONS 51 (CAR n))
) ;_ end of LIST
(COND ((AND (ASSOC 6 (CADR n)) (ASSOC 62 (CADR n)))
(LIST (ASSOC 8 (CADR n))
(ASSOC 6 (CADR n))
(ASSOC 62 (CADR n))
) ;_ end of LIST
)
((ASSOC 6 (CADR n))
(LIST (ASSOC 8 (CADR n)) (ASSOC 6 (CADR n)))
)
((ASSOC 62 (CADR n))
(LIST (ASSOC 8 (CADR n)) (ASSOC 62 (CADR n)))
)
(T (LIST (ASSOC 8 (CADR n))))
) ;_ end of COND
) ;_ end of APPEND
) ;_ end of ENTMAKE
) ;_ end of SETQ
(SETQ this_arc (ENTMAKE (LIST (CONS 0 "ARC")
(ASSOC 8 (CADR n))
(CONS 10 pick_inters)
(CONS 40 jump_rad)
) ;_ end of LIST
) ;_ end of ENTMAKE
) ;_ end of SETQ
(SETQ use_arc (ukword 1 "Yes No" "Use this arc? " "No"))
(IF (EQ use_arc "Yes")
(PROGN (SETQ used_arc this_arc)
;;; (SETVAR "pickbox" 1)
;;; (SETVAR "aperture" 1)
(COMMAND ".trim"
(ENTLAST)
""
pause
;;; (POLAR pick_inters (CAR n) (/ jump_rad 8.0))
;;; (POLAR pick_inters (+ (CAR n) PI) (/ jump_rad 8.0))
;;; (POLAR pick_inters (CAR n) (/ jump_rad 1.1))
;;; (POLAR pick_inters (+ (CAR n) PI) (/ jump_rad 1.1))
""
) ;_ end of COMMAND
;;; (SETVAR "pickbox" pick_inters_pickbox)
;;; (SETVAR "aperture" pick_inters_aperture)
) ;_ end of PROGN
(ENTDEL (ENTLAST))
) ;_ end of IF
) ;_ end of PROGN
) ;_ end of IF
) ;_ end of PROGN
) ;_ end of IF
) ;_ end of FOREACH
(FOREACH n inters_ang_lst)
) ;_ end of PROGN
) ;_ end of IF
(COMMAND ".undo" "end")
) ;_ end of PROGN
) ;_ end of IF
;;; ) ;_ end of WHILE
(SETQ *error* old_pick_inters_error)
(SETVAR "CELTYPE" pick_inters_celtype)
(SETVAR "CECOLOR" pick_inters_cecolor)
(SETVAR "osmode" pick_inters_osmode)
(SETVAR "pickbox" pick_inters_pickbox)
(SETVAR "aperture" pick_inters_aperture)
(PRINC)
) ;_ end of DEFUN
;;;****************************************************************************
(DEFUN c:lj () (c:linejump))
;;;****************************************************************************
;|«Visual LISP© Format Options»
(100 2 30 2 T "end of " 100 9 2 1 1 nil nil nil T)
;*** DO NOT add text below the comment! ***|;