3 X 6m long chords around arc

April 27

18 hours ago, andyb57J said:

andyb57J,

I just downloaded the file from my earlier post, loaded into my AutoCAD Windows 11 system and found no errors. I tested multiple angles between 10° thru 170° and every single chord was 6.0000 units long. I have no idea why you are getting different lengths. I have no experience with Civil 3D so I can not offer any solution. My version of the program seems to work.

April 27

5 hours ago, JerryFiedler said:

andyb57J,

I just downloaded the file from my earlier post, loaded into my AutoCAD Windows 11 system and found no errors. I tested multiple angles between 10° thru 170° and every single chord was 6.0000 units long. I have no idea why you are getting different lengths. I have no experience with Civil 3D so I can not offer any solution. My version of the program seems to work.

Thankyou so much. I have gotten it to work. I changed the point node numbers so that they were P5 - P8 and all works now.

Again thankyou. Is perfect for my purpose.

April 28

andyb57J,

Thank you for letting me know you got the routine running. Fixing it by changing the variable names is very strange. I wonder why that worked.

April 29

@JerryFiedler Just a comment CAL is not supported in Bricscad.

(setq x (cal "ang(apex,end1,end2)"))

Had that horrible moment during the night when you wake up, what about if I want 4 chords ? So thought will do a modification for that and the angle problem. Just make sure angle is always less than 180. Not sure about 1 chord.

April 29

@BIGAL I have my own routines, posted below, that I use in my own programs for calculating angles between actual and implied lines. I know nothing about BricsCAD so I have attached my version of CALang for your use.

; This file contains two routines to determine the angle between lines:
;	CALang2L -> Arguments are line entity names. (CALang2L ent1 ent2).
;	CALang3P -> Arguments are three points. (CALang3P apex ptA ptB).
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ Routine CALang2L ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Routine to be called by a lisp program to determine angle between two lines.
; The lines do not have to extend to their intersection point and may cross.
; The resulting angle is measured in the plane established by the two lines.
; The angle is always less than 180 degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Written: Jerry Fiedler - Apr 2025
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Example:
;	(CALang2L ent1 ent2)
; Arguments:
;	Line 1 and Line 2 entity names. They must be lines, (0 . "LINE") and must not be collinear.
; Returns:
;	Angle between Line 1 and Line2 expressed in degrees. Returns nil upon error.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun CALang2L (Line1 Line2 / p1 p2 p3 p4 apex alpha endL1 endL2 fuzz 
								obj1 obj2 chk msg)

; Set a tolerance for the "equal" function.
	(setq fuzz 0.01)

; Convert to vla objects.
	(setq obj1 (vlax-ename->vla-object Line1))
	(setq obj2 (vlax-ename->vla-object Line2))

; Verify arguments are LINES.
	(setq chk 0)
	(if (= (vlax-get obj1 'ObjectName) "AcDbLine") (setq chk 1))
	(if (= (vlax-get obj2 'ObjectName) "AcDbLine") (setq chk (+ 1 chk)))

; Get end points of both lines.
	(if (= chk 2)
		(progn
			(setq p1 (vlax-get obj1 'startpoint))
			(setq p2 (vlax-get obj1 'endpoint))
			(setq p3 (vlax-get obj2 'startpoint))
			(setq p4 (vlax-get obj2 'endpoint))
		)
	)
; Intersection of the two lines and angle calculations.
	(cond
		((< chk 2)
			(setq msg (strcat "\nArguments provided the CALang function"
							  "\nare not LINEs."
							  "\nError returns nil.\n"))
			(prompt msg)
			(setq alpha nil)
		)
		((setq apex (inters p1 p2 p3 p4 nil))
			(if (equal apex p1 fuzz)(setq endL1 p2) (setq endL1 p1))
			(if (equal apex p3 fuzz)(setq endL2 p4) (setq endL2 p3))

			; Calculate angle between the selected lines.
			(setq alpha (CALang3P apex endL1 endL2))
		)
		(t
			(setq msg (strcat "\nLines do not intersect or"
							  "\nare collinear."
							  "\nError returns nil.\n"))
			(prompt msg)
			(setq alpha nil)
		)
	)
	alpha
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ Routine CALang3P ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Routine to be called by a lisp program to determine angle between two implied lines defined by
;	Line 1 from apex to point A and Line 2 from apex to point B.
; The resulting angle is measured in the plane established by the two implied lines.
; The angle is always less than 180 degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Concept: lrm @ Cadtutor Forum - Apr 2022
; https://www.cadtutor.net/forum/topic/74922-angle-between-two-3d-points/
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Modified: Jerry Fiedler - Apr 2025
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Example:
;	(CALang3P pt1 pt2 pt3)
; Arguments:
;	Three points where pt1 is the common apex of the implied lines and pt2 pt3 are the far ends.
; Returns:
;	Angle between implied lines expressed in degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun CALang3P (p1 p2 p3 / v1 v2 angrad @acos dot)

; *********************** SUBROUTINES *****************************************
; ++++++++++++++ Function arc cos of an angle +++++++++++++++++++++++++++++++++++++++++++++++++++++
	(defun @acos (cosine / sine)
		(cond
			((zerop cosine)(* pi 0.5))
			((<= cosine -1.0) pi)
			((>= cosine 1.0) 0.0)
			(t (atan (/ (sqrt (- 1.0 (expt cosine 2))) cosine)))
		)
	)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++ Function for dot product of vectors a and b ++++++++++++++++++++++++++++++++++++++
	(defun dot (a b / dd)
		(setq dd (mapcar '* a b))
		(setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
	)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++ Calculate unit vector ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; Unit Vector  -  Lee Mac (McDonnell) www.lee-mac.com
;; Args: v - vector in R^2 or R^3
	(defun vx1 (v)
		((lambda (n) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
			(distance '(0.0 0.0 0.0) v)
		)
	)
; ++++++++++++++++++++ END SUBROUTINES ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++++++++ Main Routine +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	(setq v1 (vx1 (mapcar '- p2 p1)))
	(setq v2 (vx1 (mapcar '- p3 p1)))
	(setq angrad (@acos (dot v1 v2)))
	(if (< angrad 0.0) (setq angrad (+ pi angrad)))
	(/ (* angrad 180.0) pi)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++++++ Test Routines +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun c:test2L ( / Line1 Line2)
	(setq Line1 (car (entsel "\nPick 1st line ")))
	(setq Line2 (car (entsel "\nPick 2nd line ")))
	(CALang2L Line1 Line2)
)
(defun c:test3P ( / p1 p2 p3)
	(setq	p1 (getpoint "\nPick common point.")
			p2 (getpoint p1 "\nPick first end point.")
			p3 (getpoint p1 "\nPick second end point.")
	)
	(CALang3P p1 p2 p3)
)
(princ "\n   ...   CALang Functions by Jerry Fiedler loaded.")
(princ)

The line you pointed out in the THREE_SIX.lsp :

(setq x (cal "ang(apex,end1,end2)"))

Must be replaced with:

(setq x (CALang3P apex end1 end2))

Now the THREE_SIX.lsp should work in BricsCAD.

My version of the THREE_SIX routine could easily be modified for any ODD number of ANY length chords. For an EVEN number of chords I would have to give a bit of thought since calculating the arc radius becomes more complicated.

April 29

@JerryFiedler Thanks will have a play.

April 30

Seeing that this thread has gone on further, I think my original equation could be written in general to solve for any number of chords of given length.

Thus for any two lines intersecting at an included angle X:

Radius = (Half the chord length) divided by (sin ((180 - angle X) divided by (2 x number of chords)))

April 30

@eldon

You are correct the equation applies to either odd or even number of chords. This afternoon I sketched the trig of the two cases and found that the the equation is correct even though the geometry is slightly different. I formatted the equation in three lines simply for clarity.

; Calculate the arc radius.
	(setq u1 (- pi x))
	(setq ux (/ u1 (* 2 qty)))
	(setq rad(/ (/ len 2) (sin ux)))

Here is my final version for any quantity and length of chords. I made the line extensions a separate pline to allow the user to delete it if the extension is no longer needed at some later time. To run this version you need my CALang subroutines posted earlier in this thread. As you noted this has gone further than the OP's request but who can turn down a good challenge?

;Routine to create special fillet between two intersecting lines.
;https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/#google_vignette
;Modified: Jerry Fiedler - Apr 2025
;	Determine angle by USER selecting two lines instead of numerical input.
;	Added USER options to show arc and extend lines to apex.
;Revised: Jerry Fiedler - Apr 2025
;	Replaced Geometric Calculator function with custom routine CALang3P.
;	Made line extensions a polyline.
;	Added ability of user to input number of chords and their length.
;Reference code:
;	paulmcz - Equations for arc radius calculation.
;	BigAl - Code for creating the arc and chamfers.
;*****************************************************************************************
(defun c:3BY6 ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux x
				  end1 end2 arc len ans arcnm qty pS pE nodes j nm)
; Request desired quantity and length of chords.
	(setq qty (getint "Enter quantity of chords: "))
	(setq len (getreal "Enter chord length: "))
; Select lines.
	(setq ent1 (car (entsel "\nPick Line 1 ")))
	(setq ent2 (car (entsel "\nPick Line 2 ")))	
; Get end points of selected lines.
	(setq obj1 (vlax-ename->vla-object ent1))
	(setq obj2 (vlax-ename->vla-object ent2))
	(setq p1 (vlax-get obj1 'startpoint))
	(setq p2 (vlax-get obj1 'endpoint))
	(setq p3 (vlax-get obj2 'startpoint))
	(setq p4 (vlax-get obj2 'endpoint))
; Calculate the intersection point Line 1 and Line 2.
	(setq apex (inters p1 p2 p3 p4 nil))
; Calculate angle X.
	(if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1))
	(if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3))
	(setq x (CALang3P apex end1 end2))
	(if (> x 180) (setq x (- 360 x)))
	(setq x (* pi (/ x 180.0)))
; Calculate the arc radius.
	(setq u1 (- pi x))
	(setq ux (/ u1 (* 2 qty)))
	(setq rad(/ (/ len 2) (sin ux)))
; Create arc.
	(setvar 'filletrad rad)
	(command "fillet" ent1 ent2)
	(setq arcnm (entlast))
;	(command "chprop" arcnm "" "_LA" "P" "")
	(setq arc (vlax-ename->vla-object arcnm))
; Establish nodes for chamfers.
	(setq len (/ (vlax-get arc 'arclength) qty))
	(setq pS (vlax-get arc 'startpoint))
	(setq pE (vlax-get arc 'endpoint))
	(setq j 0)
	(repeat (1+ qty)
		(setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes))
		(setq j (1+ j))
	)
; Create chord pline from list of nodes.
; Entmake code by Lee Mac (McDonnell) Febrary 2010
; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347
	(entmake (append
		(list (cons 0 "LWPOLYLINE")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbPolyline")
			  (cons 90 (length nodes)))
		(mapcar (function (lambda (p) (cons 10 p))) nodes))
	)
; Delete arc?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "NO") (entdel arcnm))
; Extend lines to apex?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "YES")
		(progn
			(command "pline" pS apex pE "")
;			(command "chprop" (entlast) "" "_LA" "P" "")
		)
	)

	(princ)
)
(princ)

May 1

Is there a way to modify it so it remembers the last input for each prompt? Great lisp thankyou!

May 1

@JerryFiedler Nice answer, I to sometimes post a more global answer as it saves the next request of " I want four not 3." I also add dcl, as I have the multigetvals.lsp preloaded.

(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter values " "Number of chords" 5 4 "3" "Chord length " 5 4 "6")))
(setq l1 (atoi (car ans)) l2 (atof (cadr ans)))

May 1

@andyb57J, You could also go with parametric constraints if that works better. Just tossing it out there—sorry if it's out of the blue!

May 1

@BIGAL My input code was just quick and dirty to get the routine posted. I used your multigetvals.lsp for input into many of my routines over the years (decades?). It is a very fast and an easy way to make DCL input and certainly improves this posted code. Thank you for sharing it so long ago. That said, a year or two ago, I started using OpenDCL and have replaced all of your multigetvals DCL's in my library. I would never post a routine here that contained one of my OpenDCL's because, as you know, they are troublesome to share. I just like the features and look of OpenDCL.

May 1

@JTM It is possible to do what you want using global variables. Care must be taken with global variable so you don't create name conflicts. The following code creates global variables *qty3BY6* and *len3BY6* which are probably unique enough to avoid conflict in your system. I added a subroutine to input values with a default. The subroutine comes from the book "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012. I believe there is a newer version. It is a good book for lisp.

The following code uses global variables.

;Routine to create special fillet between two intersecting lines.
;https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/#google_vignette
;Modified: Jerry Fiedler - Apr 2025
;	Determine angle by USER selecting two lines instead of numerical input.
;	Added USER options to show arc and extend lines to apex.
;Revised: Jerry Fiedler - Apr 2025
;	Replaced Geometric Calculator function with custom routine CALang3P.
;	Made line extensions a polyline.
;	Added ability of user to input number of chords and their length.
;Revised: Jerry Fiedler - May 2025
;	Changed quantity and length input to global variables *qty3BY6* and *len3BY6*.
;	Added subroutine for input with default values.
;Reference code:
;	paulmcz - Equations for arc radius calculation.
;	BigAl - Code for creating the arc and chamfers.
;	LeeMac - Entmake code.
;	Reinaldo Togores - Prompt for input with default values subroutine.
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun c:3BY6 ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux x
				  end1 end2 arc len ans arcnm pS pE nodes j nm)

; Recall stored variables.
; If global variables are undefined set to zero. First time command called.
	(or *qty3BY6* (setq *qty3BY6* 0))
	(or *len3BY6* (setq *len3BY6* 0.0))
; Accept stored values or enter new values.
	(initget 6 ) ; No negative values or zero.
	(setq *qty3BY6* (default-value 'getint "\nEnter quantity of chords: " *qty3BY6*))
	(initget 6 ) ; No negative values or zero.
	(setq *len3BY6* (default-value 'getreal "\nEnter chord length: " *len3BY6*))
; Select lines.
	(setq ent1 (car (entsel "\nPick Line 1 ")))
	(setq ent2 (car (entsel "\nPick Line 2 ")))	
; Get end points of selected lines.
	(setq obj1 (vlax-ename->vla-object ent1))
	(setq obj2 (vlax-ename->vla-object ent2))
	(setq p1 (vlax-get obj1 'startpoint))
	(setq p2 (vlax-get obj1 'endpoint))
	(setq p3 (vlax-get obj2 'startpoint))
	(setq p4 (vlax-get obj2 'endpoint))
; Calculate the intersection point Line 1 and Line 2.
	(setq apex (inters p1 p2 p3 p4 nil))
; Calculate angle X.
	(if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1))
	(if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3))
	(setq x (CALang3P apex end1 end2))
	(if (> x 180) (setq x (- 360 x)))
	(setq x (* pi (/ x 180.0)))
; Calculate the arc radius.
	(setq u1 (- pi x))
	(setq ux (/ u1 (* 2 *qty3BY6*)))
	(setq rad(/ (/ *len3BY6* 2) (sin ux)))
; Create arc.
	(setvar 'filletrad rad)
	(command "fillet" ent1 ent2)
	(setq arcnm (entlast))
;	(command "chprop" arcnm "" "_LA" "P" "")
	(setq arc (vlax-ename->vla-object arcnm))
; Establish nodes for chamfers.
	(setq len (/ (vlax-get arc 'arclength) *qty3BY6*))
	(setq pS (vlax-get arc 'startpoint))
	(setq pE (vlax-get arc 'endpoint))
	(setq j 0)
	(repeat (1+ *qty3BY6*)
		(setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes))
		(setq j (1+ j))
	)
; Create chord pline from list of nodes.
; Entmake code by Lee Mac (McDonnell) Febrary 2010
; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347
	(entmake (append
		(list (cons 0 "LWPOLYLINE")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbPolyline")
			  (cons 90 (length nodes)))
		(mapcar (function (lambda (p) (cons 10 p))) nodes))
	)
; Delete arc?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "NO") (entdel arcnm))
; Extend lines to apex?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "YES")
		(progn
			(command "pline" pS apex pE "")
;			(command "chprop" (entlast) "" "_LA" "P" "")
		)
	)

	(princ)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Prompt for input with default values.
; Source: "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012
; Listing 7.1 in source book.
; Arguments:
;	func -> An AutoCAD get... function preceded with a ' (NOT for getstring)
;	message -> Prompt requesting input.
;	value -> Defalut value which is used if <Enter> is pressed at prompt.

(defun default-value (func message value / tmp)
  (if (setq tmp
             (apply
               func
               (list (strcat message
                             "<"
                             (vl-princ-to-string value)
                             ">: "
                     )
               )
             )
      )
    tmp
    value
  )
)
(princ)

THREE_SIX_Rev2.LSP

May 1

@JerryFiedler " Reinaldo N. Togores" he has 4 books at least, look on Kindle can copy code from Kindle and paste into your lisp. Very cheap.

May 19

On 02/05/2025 at 02:42, JerryFiedler said:

@JTM It is possible to do what you want using global variables. Care must be taken with global variable so you don't create name conflicts. The following code creates global variables *qty3BY6* and *len3BY6* which are probably unique enough to avoid conflict in your system. I added a subroutine to input values with a default. The subroutine comes from the book "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012. I believe there is a newer version. It is a good book for lisp.

The following code uses global variables.

;Routine to create special fillet between two intersecting lines.
;https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/#google_vignette
;Modified: Jerry Fiedler - Apr 2025
;	Determine angle by USER selecting two lines instead of numerical input.
;	Added USER options to show arc and extend lines to apex.
;Revised: Jerry Fiedler - Apr 2025
;	Replaced Geometric Calculator function with custom routine CALang3P.
;	Made line extensions a polyline.
;	Added ability of user to input number of chords and their length.
;Revised: Jerry Fiedler - May 2025
;	Changed quantity and length input to global variables *qty3BY6* and *len3BY6*.
;	Added subroutine for input with default values.
;Reference code:
;	paulmcz - Equations for arc radius calculation.
;	BigAl - Code for creating the arc and chamfers.
;	LeeMac - Entmake code.
;	Reinaldo Togores - Prompt for input with default values subroutine.
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun c:3BY6 ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux x
				  end1 end2 arc len ans arcnm pS pE nodes j nm)

; Recall stored variables.
; If global variables are undefined set to zero. First time command called.
	(or *qty3BY6* (setq *qty3BY6* 0))
	(or *len3BY6* (setq *len3BY6* 0.0))
; Accept stored values or enter new values.
	(initget 6 ) ; No negative values or zero.
	(setq *qty3BY6* (default-value 'getint "\nEnter quantity of chords: " *qty3BY6*))
	(initget 6 ) ; No negative values or zero.
	(setq *len3BY6* (default-value 'getreal "\nEnter chord length: " *len3BY6*))
; Select lines.
	(setq ent1 (car (entsel "\nPick Line 1 ")))
	(setq ent2 (car (entsel "\nPick Line 2 ")))	
; Get end points of selected lines.
	(setq obj1 (vlax-ename->vla-object ent1))
	(setq obj2 (vlax-ename->vla-object ent2))
	(setq p1 (vlax-get obj1 'startpoint))
	(setq p2 (vlax-get obj1 'endpoint))
	(setq p3 (vlax-get obj2 'startpoint))
	(setq p4 (vlax-get obj2 'endpoint))
; Calculate the intersection point Line 1 and Line 2.
	(setq apex (inters p1 p2 p3 p4 nil))
; Calculate angle X.
	(if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1))
	(if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3))
	(setq x (CALang3P apex end1 end2))
	(if (> x 180) (setq x (- 360 x)))
	(setq x (* pi (/ x 180.0)))
; Calculate the arc radius.
	(setq u1 (- pi x))
	(setq ux (/ u1 (* 2 *qty3BY6*)))
	(setq rad(/ (/ *len3BY6* 2) (sin ux)))
; Create arc.
	(setvar 'filletrad rad)
	(command "fillet" ent1 ent2)
	(setq arcnm (entlast))
;	(command "chprop" arcnm "" "_LA" "P" "")
	(setq arc (vlax-ename->vla-object arcnm))
; Establish nodes for chamfers.
	(setq len (/ (vlax-get arc 'arclength) *qty3BY6*))
	(setq pS (vlax-get arc 'startpoint))
	(setq pE (vlax-get arc 'endpoint))
	(setq j 0)
	(repeat (1+ *qty3BY6*)
		(setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes))
		(setq j (1+ j))
	)
; Create chord pline from list of nodes.
; Entmake code by Lee Mac (McDonnell) Febrary 2010
; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347
	(entmake (append
		(list (cons 0 "LWPOLYLINE")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbPolyline")
			  (cons 90 (length nodes)))
		(mapcar (function (lambda (p) (cons 10 p))) nodes))
	)
; Delete arc?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "NO") (entdel arcnm))
; Extend lines to apex?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "YES")
		(progn
			(command "pline" pS apex pE "")
;			(command "chprop" (entlast) "" "_LA" "P" "")
		)
	)

	(princ)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Prompt for input with default values.
; Source: "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012
; Listing 7.1 in source book.
; Arguments:
;	func -> An AutoCAD get... function preceded with a ' (NOT for getstring)
;	message -> Prompt requesting input.
;	value -> Defalut value which is used if <Enter> is pressed at prompt.

(defun default-value (func message value / tmp)
  (if (setq tmp
             (apply
               func
               (list (strcat message
                             "<"
                             (vl-princ-to-string value)
                             ">: "
                     )
               )
             )
      )
    tmp
    value
  )
)
(princ)

THREE_SIX_Rev2.LSP 4.52 kB · 5 downloads

Hi Jerry

Can this lisp easily be modified so that it can calculate the arc and chords with the tangent length (Y) being a set distance (Ie 6m).

'Z' will be calculated. '6' will be calculated. and Y will be a user input (ie.6m).

I would like it to run same as your attached lisp.

May 19

You need to draw the geometry and get out your old trig book. Yes it can be done. If you fix the tangent length then there will only be one radius that matches. Dont forget our old mate Pythagoras. You can't have both a tangent length and a chord length.

Have a go it's about 1/2 angle1 & 1/2 angle2. Then Pythagoras. The other two angles are 90.

May 19

5 hours ago, BIGAL said:

You need to draw the geometry and get out your old trig book. Yes it can be done. If you fix the tangent length then there will only be one radius that matches. Dont forget our old mate Pythagoras. You can't have both a tangent length and a chord length.

Have a go it's about 1/2 angle1 & 1/2 angle2. Then Pythagoras. The other two angles are 90.

I got this far with it but the result varies depending on the which line I select first. How do I fix this.

(defun c:ChamferArc (/ ent1 ent2 p1 p2 chamferDist intPt chamferLine
                       perp1 perp2 ptA ptB radius arc)

  ;; Draw perpendicular from point to line and return entity
  (defun PerpAtPoint (line pt / vec normDir lineStart lineEnd ptB)
    (setq lineStart (cdr (assoc 10 (entget line)))
          lineEnd   (cdr (assoc 11 (entget line)))
          vec (mapcar '- lineEnd lineStart)
          normDir (list (- (cadr vec)) (car vec) 0)
          ptB (mapcar '+ pt (mapcar '(lambda (x) (* 100 x)) normDir))
    )
    (entmakex
     (list (cons 0 "LINE")
           (cons 10 pt)
           (cons 11 ptB)
           (cons 62 1))) ; Red
  )

  ;; Euclidean distance
  (defun dist2d (a b)
    (sqrt (+ (expt (- (car a) (car b)) 2)
             (expt (- (cadr a) (cadr b)) 2))))

;; Get user input for chamfer distance
  (initget 6) ; accept only positive numbers
  (setq userInput (getreal "\nEnter chamfer distance <6.0>: "))
  (setq chamferDist (if userInput userInput 6.0))

  ;; Select two lines
  (prompt "\nSelect first line: ")
  (setq ent1 (car (entsel)))
  (prompt "\nSelect second line: ")
  (setq ent2 (car (entsel)))

  (if (and ent1 ent2)
    (progn
      ;; Apply chamfer
      (command "._chamfer" "D" chamferDist chamferDist)
      (command "._chamfer" ent1 ent2)

      ;; Get the chamfer line (last created)
      (setq chamferLine (entlast))
      (setq p1 (cdr (assoc 10 (entget chamferLine))))
      (setq p2 (cdr (assoc 11 (entget chamferLine))))

      ;; Draw perpendiculars
      (setq perp1 (PerpAtPoint ent1 p1))
      (setq perp2 (PerpAtPoint ent2 p2))

      ;; Get perpendicular endpoints
      (setq ptA (cdr (assoc 11 (entget perp1))))
      (setq ptB (cdr (assoc 11 (entget perp2))))

      ;; Find intersection of perpendiculars
      (setq intPt (inters p1 ptA p2 ptB nil))

      ;; Delete perpendiculars
      (if perp1 (entdel perp1))
      (if perp2 (entdel perp2))

      ;; Draw point at intersection
      (if intPt
        (entmakex
         (list (cons 0 "POINT")
               (cons 10 intPt)
               (cons 62 3))) ; Green point
      )

      ;; Calculate radius (from intersection to one chamfer point)
      (setq radius (dist2d intPt p1))

      ;; Draw arc using start (p1), end (p2), and point on arc (intPt)
      (entmakex
        (list (cons 0 "ARC")
              (cons 10 intPt)              ; Center approximation
              (cons 40 radius)             ; Radius
              (cons 100 "AcDbEntity")
              (cons 100 "AcDbCircle")
              (cons 100 "AcDbArc")
              (cons 50 (angle intPt p1))   ; Start angle
              (cons 51 (angle intPt p2)))) ; End angle

      (prompt (strcat "\nArc drawn with radius: " (rtos radius 2 3)))
	  
	  ;; Delete chamferline
      (if chamferLine (entdel chamferline))
 
   )
    (prompt "\nInvalid selection.")
  )

  (princ)
)

May 19

@andyb57J You asked me if it would be difficult to change my routine. The answer in "no". Only a few lines needed to be changed but I created a new file to keep things a bit cleaner. The main effort is to calculate the arc radius while everything else stays the same as before.

Using the sketch @BIGAL posted you can see all the geometry needed. He also pointed out that we know the angles and our old Greek friends provide all the formulas we need to solve for the arc radius.

In my routine your value "Y" is the global variable *posCatY*. I called this the "position of fillet" in the input prompt.

Variable *qtyCatY* is the number of chords desired.

; Routine to create special fillet between two intersecting lines.
; Results in any number of EQUAL length chords a specifed distance from the point of intersection.
; Uses global variables *qtyCatY* and *posCatY* to remember input.
; Various subroutines are included in this file.
; Refence:
; https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Written: Jerry Fiedler - May 2025
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; USER selects two intersecting lines, specifies distance to "fillet" and quantity of chords.
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun c:CatY ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux X A
				  end1 end2 arc len ans arcnm pS pE nodes j nm c)

; Recall stored variables.
; If global variables are undefined set to zero. First time command called.
	(or *qtyCatY* (setq *qtyCatY* 0))
	(or *posCatY* (setq *posCatY* 0.0))
; Accept stored values or enter new values.
	(initget 6 ) ; No negative values or zero.
	(setq *qtyCatY* (default-value 'getint "\nEnter quantity of chords: " *qtyCatY*))
	(initget 6 ) ; No negative values or zero.
	(setq *posCatY* (default-value 'getreal "\nEnter position of fillet: " *posCatY*))
; Select lines.
	(setq ent1 (car (entsel "\nPick Line 1 ")))
	(setq ent2 (car (entsel "\nPick Line 2 ")))	
; Get end points of selected lines.
	(setq obj1 (vlax-ename->vla-object ent1))
	(setq obj2 (vlax-ename->vla-object ent2))
	(setq p1 (vlax-get obj1 'startpoint))
	(setq p2 (vlax-get obj1 'endpoint))
	(setq p3 (vlax-get obj2 'startpoint))
	(setq p4 (vlax-get obj2 'endpoint))
; Calculate the intersection point Line 1 and Line 2.
	(setq apex (inters p1 p2 p3 p4 nil))
; Calculate angle X at point of intersection.
	(if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1))
	(if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3))
	(setq X (CALang3P apex end1 end2))
	(if (> X 180) (setq X (- 360 X)))
	(setq X (* pi (/ X 180.0)))
; Calculate the arc radius.
	(setq A (- pi X))
	(setq c (* *posCatY* (sin (/ X 2))))
	(setq rad (/ c (sin (/ A 2))))
; Create arc.
	(setvar 'filletrad rad)
	(command "fillet" ent1 ent2)
	(setq arcnm (entlast))
;	(command "chprop" arcnm "" "_LA" "P" "")
	(setq arc (vlax-ename->vla-object arcnm))
; Establish nodes for chamfers.
	(setq len (/ (vlax-get arc 'arclength) *qtyCatY*))
	(setq pS (vlax-get arc 'startpoint))
	(setq pE (vlax-get arc 'endpoint))
	(setq j 0)
	(repeat (1+ *qtyCatY*)
		(setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes))
		(setq j (1+ j))
	)
; Create chord pline from list of nodes.
; Entmake code by Lee Mac (McDonnell) Febrary 2010
; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347
	(entmake (append
		(list (cons 0 "LWPOLYLINE")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbPolyline")
			  (cons 90 (length nodes)))
		(mapcar (function (lambda (p) (cons 10 p))) nodes))
	)
; Delete arc?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "NO") (entdel arcnm))
; Extend lines to apex?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "YES")
		(progn
			(command "pline" pS apex pE "")
;			(command "chprop" (entlast) "" "_LA" "P" "")
		)
	)

	(princ)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Prompt for input with default values.
; Source: "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012
; Listing 7.1 in source book.
; Arguments:
;	func -> An AutoCAD get... function preceded with a ' (NOT for getstring)
;	message -> Prompt requesting input.
;	value -> Defalut value which is used if <Enter> is pressed at prompt.

(defun default-value (func message value / tmp)
  (if (setq tmp
             (apply
               func
               (list (strcat message
                             "<"
                             (vl-princ-to-string value)
                             ">: "
                     )
               )
             )
      )
    tmp
    value
  )
)
; This file contains two routines to determine the angle between lines:
;	CALang2L -> Arguments are line entity names. (CALang2L ent1 ent2).
;	CALang3P -> Arguments are three points. (CALang3P apex ptA ptB).
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ Routine CALang2L ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Routine to be called by a lisp program to determine angle between two lines.
; The lines do not have to extend to their intersection point and may cross.
; The resulting angle is measured in the plane established by the two lines.
; The angle is always less than 180 degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Written: Jerry Fiedler - Apr 2025
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Example:
;	(CALang2L ent1 ent2)
; Arguments:
;	Line 1 and Line 2 entity names. They must be lines, (0 . "LINE") and must not be collinear.
; Returns:
;	Angle between Line 1 and Line2 expressed in degrees. Returns nil upon error.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun CALang2L (Line1 Line2 / p1 p2 p3 p4 apex alpha endL1 endL2 fuzz 
								obj1 obj2 chk msg)

; Set a tolerance for the "equal" function.
	(setq fuzz 0.01)

; Convert to vla objects.
	(setq obj1 (vlax-ename->vla-object Line1))
	(setq obj2 (vlax-ename->vla-object Line2))

; Verify arguments are LINES.
	(setq chk 0)
	(if (= (vlax-get obj1 'ObjectName) "AcDbLine") (setq chk 1))
	(if (= (vlax-get obj2 'ObjectName) "AcDbLine") (setq chk (+ 1 chk)))

; Get end points of both lines.
	(if (= chk 2)
		(progn
			(setq p1 (vlax-get obj1 'startpoint))
			(setq p2 (vlax-get obj1 'endpoint))
			(setq p3 (vlax-get obj2 'startpoint))
			(setq p4 (vlax-get obj2 'endpoint))
		)
	)
; Intersection of the two lines and angle calculations.
	(cond
		((< chk 2)
			(setq msg (strcat "\nArguments provided the CALang function"
							  "\nare not LINEs."
							  "\nError returns nil.\n"))
			(prompt msg)
			(setq alpha nil)
		)
		((setq apex (inters p1 p2 p3 p4 nil))
			(if (equal apex p1 fuzz)(setq endL1 p2) (setq endL1 p1))
			(if (equal apex p3 fuzz)(setq endL2 p4) (setq endL2 p3))

			; Calculate angle between the selected lines.
			(setq alpha (CALang3P apex endL1 endL2))
		)
		(t
			(setq msg (strcat "\nLines do not intersect or"
							  "\nare collinear."
							  "\nError returns nil.\n"))
			(prompt msg)
			(setq alpha nil)
		)
	)
	alpha
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ Routine CALang3P ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Routine to be called by a lisp program to determine angle between two implied lines defined by
;	Line 1 from apex to point A and Line 2 from apex to point B.
; The resulting angle is measured in the plane established by the two implied lines.
; The angle is always less than 180 degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Concept: lrm @ Cadtutor Forum - Apr 2022
; https://www.cadtutor.net/forum/topic/74922-angle-between-two-3d-points/
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Modified: Jerry Fiedler - Apr 2025
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Example:
;	(CALang3P pt1 pt2 pt3)
; Arguments:
;	Three points where pt1 is the common apex of the implied lines and pt2 pt3 are the far ends.
; Returns:
;	Angle between implied lines expressed in degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun CALang3P (p1 p2 p3 / v1 v2 angrad @acos dot)

; *********************** SUBROUTINES *****************************************
; ++++++++++++++ Function arc cos of an angle +++++++++++++++++++++++++++++++++++++++++++++++++++++
	(defun @acos (cosine / sine)
		(cond
			((zerop cosine)(* pi 0.5))
			((<= cosine -1.0) pi)
			((>= cosine 1.0) 0.0)
			(t (atan (/ (sqrt (- 1.0 (expt cosine 2))) cosine)))
		)
	)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++ Function for dot product of vectors a and b ++++++++++++++++++++++++++++++++++++++
	(defun dot (a b / dd)
		(setq dd (mapcar '* a b))
		(setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
	)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++ Calculate unit vector ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; Unit Vector  -  Lee Mac (McDonnell) www.lee-mac.com
;; Args: v - vector in R^2 or R^3
	(defun vx1 (v)
		((lambda (n) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
			(distance '(0.0 0.0 0.0) v)
		)
	)
; ++++++++++++++++++++ END SUBROUTINES ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++++++++ Main Routine +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	(setq v1 (vx1 (mapcar '- p2 p1)))
	(setq v2 (vx1 (mapcar '- p3 p1)))
	(setq angrad (@acos (dot v1 v2)))
	(if (< angrad 0.0) (setq angrad (+ pi angrad)))
	(/ (* angrad 180.0) pi)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(princ)

Load the file and then run with c:CatY.

Chords-at-Y.lsp

May 19

3 hours ago, JerryFiedler said:

@andyb57J You asked me if it would be difficult to change my routine. The answer in "no". Only a few lines needed to be changed but I created a new file to keep things a bit cleaner. The main effort is to calculate the arc radius while everything else stays the same as before.

Using the sketch @BIGAL posted you can see all the geometry needed. He also pointed out that we know the angles and our old Greek friends provide all the formulas we need to solve for the arc radius.

In my routine your value "Y" is the global variable *posCatY*. I called this the "position of fillet" in the input prompt.

Variable *qtyCatY* is the number of chords desired.

; Routine to create special fillet between two intersecting lines.
; Results in any number of EQUAL length chords a specifed distance from the point of intersection.
; Uses global variables *qtyCatY* and *posCatY* to remember input.
; Various subroutines are included in this file.
; Refence:
; https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Written: Jerry Fiedler - May 2025
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; USER selects two intersecting lines, specifies distance to "fillet" and quantity of chords.
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun c:CatY ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux X A
				  end1 end2 arc len ans arcnm pS pE nodes j nm c)

; Recall stored variables.
; If global variables are undefined set to zero. First time command called.
	(or *qtyCatY* (setq *qtyCatY* 0))
	(or *posCatY* (setq *posCatY* 0.0))
; Accept stored values or enter new values.
	(initget 6 ) ; No negative values or zero.
	(setq *qtyCatY* (default-value 'getint "\nEnter quantity of chords: " *qtyCatY*))
	(initget 6 ) ; No negative values or zero.
	(setq *posCatY* (default-value 'getreal "\nEnter position of fillet: " *posCatY*))
; Select lines.
	(setq ent1 (car (entsel "\nPick Line 1 ")))
	(setq ent2 (car (entsel "\nPick Line 2 ")))	
; Get end points of selected lines.
	(setq obj1 (vlax-ename->vla-object ent1))
	(setq obj2 (vlax-ename->vla-object ent2))
	(setq p1 (vlax-get obj1 'startpoint))
	(setq p2 (vlax-get obj1 'endpoint))
	(setq p3 (vlax-get obj2 'startpoint))
	(setq p4 (vlax-get obj2 'endpoint))
; Calculate the intersection point Line 1 and Line 2.
	(setq apex (inters p1 p2 p3 p4 nil))
; Calculate angle X at point of intersection.
	(if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1))
	(if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3))
	(setq X (CALang3P apex end1 end2))
	(if (> X 180) (setq X (- 360 X)))
	(setq X (* pi (/ X 180.0)))
; Calculate the arc radius.
	(setq A (- pi X))
	(setq c (* *posCatY* (sin (/ X 2))))
	(setq rad (/ c (sin (/ A 2))))
; Create arc.
	(setvar 'filletrad rad)
	(command "fillet" ent1 ent2)
	(setq arcnm (entlast))
;	(command "chprop" arcnm "" "_LA" "P" "")
	(setq arc (vlax-ename->vla-object arcnm))
; Establish nodes for chamfers.
	(setq len (/ (vlax-get arc 'arclength) *qtyCatY*))
	(setq pS (vlax-get arc 'startpoint))
	(setq pE (vlax-get arc 'endpoint))
	(setq j 0)
	(repeat (1+ *qtyCatY*)
		(setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes))
		(setq j (1+ j))
	)
; Create chord pline from list of nodes.
; Entmake code by Lee Mac (McDonnell) Febrary 2010
; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347
	(entmake (append
		(list (cons 0 "LWPOLYLINE")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbPolyline")
			  (cons 90 (length nodes)))
		(mapcar (function (lambda (p) (cons 10 p))) nodes))
	)
; Delete arc?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "NO") (entdel arcnm))
; Extend lines to apex?
	(initget "YES NO")
	(setq ans "NO")
	(setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES")))
	(if (= ans "YES")
		(progn
			(command "pline" pS apex pE "")
;			(command "chprop" (entlast) "" "_LA" "P" "")
		)
	)

	(princ)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Prompt for input with default values.
; Source: "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012
; Listing 7.1 in source book.
; Arguments:
;	func -> An AutoCAD get... function preceded with a ' (NOT for getstring)
;	message -> Prompt requesting input.
;	value -> Defalut value which is used if <Enter> is pressed at prompt.

(defun default-value (func message value / tmp)
  (if (setq tmp
             (apply
               func
               (list (strcat message
                             "<"
                             (vl-princ-to-string value)
                             ">: "
                     )
               )
             )
      )
    tmp
    value
  )
)
; This file contains two routines to determine the angle between lines:
;	CALang2L -> Arguments are line entity names. (CALang2L ent1 ent2).
;	CALang3P -> Arguments are three points. (CALang3P apex ptA ptB).
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ Routine CALang2L ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Routine to be called by a lisp program to determine angle between two lines.
; The lines do not have to extend to their intersection point and may cross.
; The resulting angle is measured in the plane established by the two lines.
; The angle is always less than 180 degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Written: Jerry Fiedler - Apr 2025
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Example:
;	(CALang2L ent1 ent2)
; Arguments:
;	Line 1 and Line 2 entity names. They must be lines, (0 . "LINE") and must not be collinear.
; Returns:
;	Angle between Line 1 and Line2 expressed in degrees. Returns nil upon error.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun CALang2L (Line1 Line2 / p1 p2 p3 p4 apex alpha endL1 endL2 fuzz 
								obj1 obj2 chk msg)

; Set a tolerance for the "equal" function.
	(setq fuzz 0.01)

; Convert to vla objects.
	(setq obj1 (vlax-ename->vla-object Line1))
	(setq obj2 (vlax-ename->vla-object Line2))

; Verify arguments are LINES.
	(setq chk 0)
	(if (= (vlax-get obj1 'ObjectName) "AcDbLine") (setq chk 1))
	(if (= (vlax-get obj2 'ObjectName) "AcDbLine") (setq chk (+ 1 chk)))

; Get end points of both lines.
	(if (= chk 2)
		(progn
			(setq p1 (vlax-get obj1 'startpoint))
			(setq p2 (vlax-get obj1 'endpoint))
			(setq p3 (vlax-get obj2 'startpoint))
			(setq p4 (vlax-get obj2 'endpoint))
		)
	)
; Intersection of the two lines and angle calculations.
	(cond
		((< chk 2)
			(setq msg (strcat "\nArguments provided the CALang function"
							  "\nare not LINEs."
							  "\nError returns nil.\n"))
			(prompt msg)
			(setq alpha nil)
		)
		((setq apex (inters p1 p2 p3 p4 nil))
			(if (equal apex p1 fuzz)(setq endL1 p2) (setq endL1 p1))
			(if (equal apex p3 fuzz)(setq endL2 p4) (setq endL2 p3))

			; Calculate angle between the selected lines.
			(setq alpha (CALang3P apex endL1 endL2))
		)
		(t
			(setq msg (strcat "\nLines do not intersect or"
							  "\nare collinear."
							  "\nError returns nil.\n"))
			(prompt msg)
			(setq alpha nil)
		)
	)
	alpha
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ Routine CALang3P ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Routine to be called by a lisp program to determine angle between two implied lines defined by
;	Line 1 from apex to point A and Line 2 from apex to point B.
; The resulting angle is measured in the plane established by the two implied lines.
; The angle is always less than 180 degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Concept: lrm @ Cadtutor Forum - Apr 2022
; https://www.cadtutor.net/forum/topic/74922-angle-between-two-3d-points/
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Modified: Jerry Fiedler - Apr 2025
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Example:
;	(CALang3P pt1 pt2 pt3)
; Arguments:
;	Three points where pt1 is the common apex of the implied lines and pt2 pt3 are the far ends.
; Returns:
;	Angle between implied lines expressed in degrees.
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun CALang3P (p1 p2 p3 / v1 v2 angrad @acos dot)

; *********************** SUBROUTINES *****************************************
; ++++++++++++++ Function arc cos of an angle +++++++++++++++++++++++++++++++++++++++++++++++++++++
	(defun @acos (cosine / sine)
		(cond
			((zerop cosine)(* pi 0.5))
			((<= cosine -1.0) pi)
			((>= cosine 1.0) 0.0)
			(t (atan (/ (sqrt (- 1.0 (expt cosine 2))) cosine)))
		)
	)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++ Function for dot product of vectors a and b ++++++++++++++++++++++++++++++++++++++
	(defun dot (a b / dd)
		(setq dd (mapcar '* a b))
		(setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
	)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++ Calculate unit vector ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; Unit Vector  -  Lee Mac (McDonnell) www.lee-mac.com
;; Args: v - vector in R^2 or R^3
	(defun vx1 (v)
		((lambda (n) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
			(distance '(0.0 0.0 0.0) v)
		)
	)
; ++++++++++++++++++++ END SUBROUTINES ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ++++++++++++++++++++ Main Routine +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	(setq v1 (vx1 (mapcar '- p2 p1)))
	(setq v2 (vx1 (mapcar '- p3 p1)))
	(setq angrad (@acos (dot v1 v2)))
	(if (< angrad 0.0) (setq angrad (+ pi angrad)))
	(/ (* angrad 180.0) pi)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(princ)

Load the file and then run with c:CatY.

Chords-at-Y.lsp 9.79 kB · 0 downloads

This is perfect. Thankyou for everything

May 19

@andyb57J My pleasure to help. Thank you for letting me know it works for you.

Sign In

3 X 6m long chords around arc

Recommended Posts

JerryFiedler

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

JerryFiedler

BIGAL

Posted Images

andyb57J

JerryFiedler

BIGAL

JerryFiedler

BIGAL

eldon

JerryFiedler

JTM

BIGAL

LanloyLisp

JerryFiedler

JerryFiedler

BIGAL

andyb57J

BIGAL

andyb57J

JerryFiedler

andyb57J

JerryFiedler

Join the conversation

JerryFiedler

BIGAL

Tutorials

Forums

Activity