Jump to content

Recommended Posts

Posted (edited)

@eldonSorry For some reason, I didn't include the image with the message I thought I had attached. I'm sorry for the misunderstanding. After reading Jerry Felder's comment, I thought of a knot as a symbol of the difficulty in solving this. I really can only feel grateful to you for your interest in helping me.

I'll delete that image.

 

Edited by Vica
Posted

@Vica

 

The picture above is interesting but seems irrelevant to this thread. Start another thread.

 

I have been thinking in 2D only and when there is a change in direction from one straight line to another, the transition is smooth. The eye would quickly pick up any unevenness around the joint.

 

I could not image a real-life situation when a change would be in uneven chords. So the initial lisp offering with equal chords should be useful. One involving differing chord lengths would be an interesting project, but would never be used practically.

Posted

I have split the varying chord questions to a new thread so as not to add tangential subject to the original thread.

 

If needed here is the original thread.

 

Posted

I think there must be an orthodox, elegant, and straightforward way, using a good formulation, to solve this. Perhaps @Jerry Fiedler or someone else will find it at some point.

I've been thinking about this too and have come up with a different approach.

Let me explain:
a) Suppose we have a circle with sufficient dimensions to contain the chords we request.
b) Let's also suppose we calculate the subtended arcs for each of the chords, add them up, and compare the resulting angle with that of the arc into which we will fit those chords.
c) Finally, suppose that depending on the difference, we increase or decrease the radius until that difference is less than 1e-12.
If we manage to solve all this, we will only have to:
- calculate the angular directions, from the center of the arc, of each of the chord ends
- obtain those ends by polars and draw each of the chords

 

I'm trying to write some code that does this.
I'll publish it soon.

Posted

I have developed three equations with the three unknown angles.  Unfortunately they are not linear since there are ratios of sines.  I will start writing a lisp routine tomorrow but I am not a very fast programmer so don't hold your breath.  My method will be similar to @GLAVCVS method since I will be stepping through the three equations using one of the angles until the third equation is zero (fuzz).  It is a rather simple process; hope it works.

Posted (edited)

Here is my solution to the multi-chord length problem. We have three unknown subtended angles and three equations.  The first equation sums the individual angles:  2*a1 + 2*a2 + a3 = A/2.  The angles a1, a2 and a3 are half the subtended arc associated with chord 1, 2 and 3 and A/2 is half the overall angle.

The chord length is: Ci = 2*rad*Sin(ai) or the half-chord ci = rad*Sin(ai).

Solving for rad = ci / Sin(ai).  This is true for each chord since there is only one radius.  Therefore c1 / Sin(a1) = c2 / Sin(a2)= c3 / Sin(a3).  Taking the first two we get: Sin(a2) = c2*Sin(a1) / c1.

This gives us our second equation: a2 = arcsine( c2*Sin(a1) / c1).

Our third equation: a3 =  arcsine( c3*Sin(a1) / c1).

The code solves the three nonlinear equations for the three unknowns by incrementing angle a1 by a very small value and calculating a2 and a3 until equation 1 is more or less zero. The code uses 2*a1 + 2*a2 + a3 - A/2 --> 0.  Starting with a small a1 this equation is negative so the solution is when the equation flips to positive. I found that stepping a1 by 0.0000005 provided good results. It takes a second or two to solve on my PC but the value can be adjusted for either more accuracy or faster time.

 

An added feature of this version allows creating either 2, 3, 4 or 5 chords by inputting zero length for chords 2 or 3 or both.  C1 must always have a length.  Refer to the comments at the top of the lisp code.

 

This code has no error checking. However, if the calculated radius is too large for the selected lines the "fillet" command that draws the arc will throw an error.  I know of no way to correct for this since the routine simply creates a multi-faceted "fillet".  If you can't draw a radius fillet then you cannot  draw a multi-faceted fillet either.  You will have to revisit your geometry.

 

I think it works but please let me know if you have problems.

 

; Routine to add chords of different lengths on an arc tangent to two intersecting lines.
; Routine creates two to five chords of varying lengths symmetrically placed.
;
; Five chords (input three chord lengths):
; Chords 1 - 2 - 3 - 2 - 1 from start to end of arc.
;
; Four chords (input chord 3 length = 0.0):
; Chords 1 - 2 - 2 - 1 from start to end of arc.
;
; Three chords (input chord 2 length = 0.0):
; Chords 1 - 3 - 1 from start to end of arc.
;
; Two chords (input chord 2 and 3 length = 0.0)
; Chords 1 - 1 from start to end of arc.
;
; Routine uses global variables to store the chord lengths.
;
; Reference:
; https://www.cadtutor.net/forum/topic/97799-get-chords-of-two-or-three-different-lengths-on-the-same-arc/
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Written: Jerry Fiedler - May 2025
;	LeeMac - asin and entmake code.
;	Reinaldo Togores - Prompt for input with default values subroutine.
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun c:multichord ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 apex rad A X C1 C2 C3
					  end1 end2 arc len ans arcnm pS pE nodes j K1 K2 K3 done
					  arc1 arc2 arc3 lenlst a1 a2 a3)

; Recall stored variables.
; If global variables are undefined set to zero. First time command called.
	(or *multichordC1* (setq *multichordC1* 0))
	(or *multichordC2* (setq *multichordC2* 0.0))
	(or *multichordC3* (setq *multichordC3* 0.0))
; Accept stored values or enter new values.
	(initget 6) ; No negative values or zero.
	(setq *multichordC1* (default-value 'getreal "\nEnter length of chord ONE: " *multichordC1*))
	(initget 4) ; No negative.
	(setq *multichordC2* (default-value 'getreal "\nEnter length of chord TWO: " *multichordC2*))
	(initget 4) ; No negative.
	(setq *multichordC3* (default-value 'getreal "\nEnter length of chord THREE: " *multichordC3*))
	(setq C1 *multichordC1*)
	(setq C2 *multichordC2*)
	(setq C3 *multichordC3*)
; 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 A between two lines.
	(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 A)))
	(setq X (* pi (/ X 180.0)))
	(setq A (- pi X))
; Solve for the three unknown half-angles subtended by each chord, a1, a2 and a3.
; Constants.
	(setq K1 (/ A 2))
	(setq K2 (/ C2 C1))
	(setq K3 (/ C3 C1))
; Step through the three equations using a1 as the index.
	(setq done t)
	(setq a1 0.0175)
	(while done
		(setq a1 (+ a1 0.0000005))
		(if (> a1 1.57) (progn (prompt "\nNo Solution")(setq done nil)))
		(setq a2 (asin (* (sin a1) K2)))
		(setq a3 (asin (* (sin a1) K3)))
		(if (> (+ (* 2 a1) (* 2 a2) a3 (- K1)) 0.0) (setq done nil))
	)
	(setq rad (/ (/ C1 2) (sin a1)))
; 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 chords.
	(setq pS (vlax-get arc 'startpoint))
	(setq pE (vlax-get arc 'endpoint))
	(setq arc1 (* 2 rad a1)
		  arc2 (* 2 rad a2)
		  arc3 (* 2 rad a3)
	)
	(setq lenlst (list arc1 arc2 arc3 arc2))
	(setq j 0)
	(setq len 0)
	(repeat 4
		(setq len (+ len (nth j lenlst)))
		(setq nodes (cons (vlax-curve-getpointatdist arc len) nodes))
		(setq j (1+ j))
	)
	(setq nodes (cons pE nodes))
	(setq nodes (append nodes (list pS)))
; 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)
)

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++ SUBROUTINES +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; 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
  )
)
; 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)
)
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ArcSine  -  Lee Mac https://www.lee-mac.com/mathematicalfunctions.html
; Args: -1 <= x <= 1
(defun asin ( x )
    (if (<= -1.0 x 1.0)
        (atan x (sqrt (- 1.0 (* x x))))
    )
)

(princ)

 

MultiChord.lsp

Edited by JerryFiedler
Typo in global variable setq
  • Thanks 1
Posted

Great working out the answer, I thought it would be related to arc length = R * theta.

 

I may have another go using my prior code of fraction of angle but add the step function reducing or increasing the radius till the last chord distance is correct. This way can do 4 3 2 1 and so on, should be able to do as many chords as wanted rather than just 3 as a pattern.

Posted (edited)

Hi

I created the main function, but I've been busy for a couple of days and didn't have time to prepare a small interface with a dialog box.

The idea also struck me to write some code to add the option to obtain the chords of the complementary angle to the command (as in the following image) 

DualChords.png.3887fde3dce603d587afad0c4d39da55.png

 

As if that weren't enough, I also came up with a possible solution using a system of as many equations as there are chords + 1 to calculate.

Too many ideas for so little time.

So, for now, I'll leave a version of <<Extravagant Chords V.1>> that can be run from the command line. 

 

The tool will work on 'LINE's and 'LWPOLYLINE's and should be used, in the latter case, by selecting the end segments of the selected polyline or polylines so that the ends are correctly joined with the calculated chords.

The number of chords to be entered is unlimited

 

PS: A tool like this, contrary to what @Eldon thinks, if it becomes an option available to a designer or architect, I think it could be used frequently over time.

 

; Made for https://www.cadtutor.net/forum/topic/97799 14/05/2025 
;                                                                
;******** << E x t r a v a g a n t   C h o r d s  V.1 >> ********
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:ExtravagantChords (/ para in sc lCs op errores error0)
  (defun errores (mens)
    (setq *error* error0)
    (prin1)
  )
  (defun obtPtsCuerdas (lCds op / p1 p2 p3 p4 radio dameAng dameASubt d1 d2 v f ab T1 T2 pR rf1 rf2 ct r ld pa b x p o le1 le2 s1 s2 px1 px2 les)
    (defun radio (aT lc / Rmin Rmax R1/2 tl ta dameAngulos); donde 'aT' es el angulo del arco a 'acordar' y 'lc' la lista de las longitudes de las cuerdas a aplicar
      (defun dameAngulos (R / a); obtenemos suma total de los arcos subtendidos
        (apply '+ (mapcar '(lambda (L) (* 2 (atan (setq a (/ L (* 2.0 R))) (sqrt (- 1.0 (* a a)))))) lc))
      )
      (setq Rmin (/ (apply 'max lc) 2.0)	; radio mínimo posible
  	    Rmax 1e6			; radio máximo arbitrario
	    tl   1e-12			; tolerancia
      )
      (while (> (- Rmax Rmin) tl); Búsqueda por bisección
        (if (> (dameAngulos (setq R1/2 (/ (+ Rmin Rmax) 2.0))) aT)
          (setq Rmin R1/2)			; el radio es demasiado pequeño
          (setq Rmax R1/2)			; el radio es demasiado grande
        )
      )
      (/ (+ Rmin Rmax) 2.0); Devolvemos el promedio del rango de radios posibles encontrados
    )
    (defun actEs (/ l r so ls l?)
      (foreach l (list (list px1 (car le1) d1) (list px2 (car le2) d2))
        (setq r (equal (distance (car l) (cdr (assoc 10 (setq ls (entget (cadr l)))))) 0. 1e-6)
          l? (= (cdr (assoc 0 ls)) "LINE") 
	      so (if (equal (caddr l) (angle v (car o)) 1e-6) (car o) (last o))
        )
        (entmod (subst (cons (if (and l? (not r)) 11 10) so) (assoc (if (and l? (not r)) 11 10) (if r ls (reverse ls))) ls))
      )
    )
    (defun dameAng (p1 p2 p3 p4 / f) ; ESTA FUNCION SIEMPRE DEVUELVE EL ANGULO INFERIOR A PI
      (if (> (setq f (abs (- (angle p1 p2) (angle p3 p4)))) pi) (- (* 2 pi) f) f)
    )
    (defun dameASubt (l r / a) ; devuelve el arco subtendido para la cuerda de longitud l sobre el arco de radio r
      (* 2.0 (atan (setq a (/ l (* 2.0 r))) (sqrt (- 1.0 (* a a)))))
    )
    (defun os (le / x pk tm f d p i s a b tam)
      (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))))
      (while (and
	       (if x x (setq x (entget (car le)) pk (if (= (cdr (assoc 0 x)) "LWPOLYLINE") (cadr le)) b t))
               (setq f (cdr (assoc (if pk 10 11) (setq x (cdr (member (setq p (assoc 10 x)) x))))))
	       (if pk (not (inters f (cdr p) (polar pk (+ (setq a (angle f (cdr p))) 1.5708) tam) (polar pk (- a 1.5708) tam))))
             )
      )
      (list (cdr p) f)
    )
    (if (setq s1 (os (setq le1 (entsel "\nSelect FIRST segment..."))))
      (if (setq s2 (os (setq le2 (entsel "\nSelect SECOND segment..."))))
        (if (setq v (inters (setq p1 (car s1)) (setq p2 (cadr s1)) (setq p3 (car s2)) (setq p4 (cadr s2)) nil));(inters p1 p2 p3 p4 nil))
          (setq d1 (if (< (distance V p1) (distance V p2)) (angle (setq px1 p1) p2) (angle (setq px1 p2) p1)) ;d1 es la direccion del primer segmento
	        d2 (if (< (distance V p3) (distance V p4)) (angle (setq px2 p3) p4) (angle (setq px2 p4) p3)) ;d2 es la direccion del segundo segmento
	        f (if (> (setq f (abs (- d1 d2))) pi) (- (* 2 pi) f) f) ;aseguramos angulo minimo. f es el angulo incluido entre las 2 lineas
	        ab (+ ((if (> (abs (- d1 d2)) PI) max min) d1 d2) (/ f 2.0)) ;angulo bisectriz
	        T1 (inters V (polar V d1 10000) (setq pR (polar V ab 100)) (polar pR (+ d1 (/ pi 2)) 10000) nil) ;punto tangente 1 (temporal para cálculos previos)
	        T2 (inters V (polar V d2 10000) pR (polar pR (+ d2 (/ pi 2.0)) 10000) nil) ;punto tangente 2 (temporal para cálculos previos)
	        ct (inters T1 (polar T1 (+ d1 (/ pi 2)) 100) v (polar v ab 100) nil) ; calculamos centro (temporal para cálculos previos)
	         r (radio (dameAng ct T1 ct T2) lCds) ;radio necesario para encajar las cuerdas
	        ld (/ r (/ (sin (/ f 2.0)) (cos (/ f 2.0)))) ; calculamos el cateto largo hasta el punto tangente del arco
	        ct (inters (setq pa (polar v d1 ld)) (polar pa (+ d1 (/ pi 2)) 100) v (polar v ab 100) nil) ; calculamos el centro del arco
	        rf1 (angle pR T1)
	        rf2 (angle pR T2)
	        b ((if (> (abs (- rf1 rf2)) PI) max min) rf1 rf2) ; angulo base para obtener puntos de cuerdas por polares
	        x (foreach c lCds
	            (setq o (cons
			      (polar ct (if (> (setq g (+ b (dameASubt c r)) ) 6.2831853) (- g 6.2831853) g) r)
			      (if o o (list (polar ct b r)))
		            )
		          b g
	            )
		  )
		x (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbPolyline") (cons 90 (length o))) (mapcar '(lambda(x) (cons 10 x)) o)))
	        x (if op (actEs))
          )
        )
      )
    )
    (princ)
  )
  (setq error0  *error*
	*error* errores
  )
  (while (not para)
    (setq sc (getreal (strcat "\rIndicate length CHORD number " (itoa (setq in (if in (1+ in) 1))) " (CounterClockWise) (or ENTER to finish): ")))
    (if sc
      (setq lCs (append lcs (list sc)))
      (setq para T)
    )
  )
  (while (not (member (setq op (strcase (getstring "\rDo you want to snap lines/lwpolylines to calculated chords? <YES>/NO: "))) '("" "Y" "N")))
    (princ "\n*** Invalid option. Try again (ENTER, Y or N)... ***")
  )
  (obtPtsCuerdas lCs (if (= op "N") nil T))
  (princ)
)

 

I apologize for not translating the comments.

 

Edited by GLAVCVS
  • Thanks 1
Posted
1 hour ago, GLAVCVS said:

.......PS: A tool like this, contrary to what @Eldon thinks, if it becomes an option available to a designer or architect, I think it could be used frequently over time.......

 

My comment was made with the best intentions of trying to save unnecessary efforts by the good natured folk on this forum.

 

When too many chords are used, the difference between chords and arcs is very slight and if you think it will be extensively used, then so be it.

 

I was hoping that someone could try the parametric constraints which are inbuilt. My version of AutoCAD is too early so I can't try parametric constraints, and I make do with a spreadsheet!

 

For interest, I tried it my way with two lines and an included angle of 73 degrees and seven chords of length 5, 1, 5, 1, 5, 1, 5 and arrived at a radius of 12.390394.

 

 

multi-chord.PNG

Posted

I was going to comment earlier, but as @GLAVCVS states, I have indeed used similar out in the real world.

 

Not all that uncommon in some of the industries I have worked in.

 

Though I never needed a LISP or Program to do the work. So I don't really disagree with what @eldon stated.

 

When I did machining school for Aircraft we did 3 angle valve cuts, also on any head work I have had done for cars, trucks, motorcycles, for hot rods they sometimes go 5 angle (more performance airflow than 3 angle, but faster wear), so look up multi-angle valve seats and valve grinds. (Also they do a multi-radius valve jobs)

 

Multiple Angle Valve and Seat Machining - Aircraft Engine Overhaul

 

That might be a new challenge with all the different angles. There is most likely a formula around, it's been a while since I did much machining.

 

I have machined and designed parts with ends similar to GLAVCVS' image.

 

I did some thinking on this subject, but I'll wait and see what the experts come up with, so far, pretty good it seems.

 

P.S.

Last time I used more than a couple of constraints it bogged down my drawing, but that's been a while. Maybe time permitting, I can give it a go.

Posted

@GLAVCVS I tried your program and it is very nice.  Yesterday I was thinking of writing a random chord length routine but you seem to have a good solution, so now I will just study your code to see what I can learn.

  • Like 2
Posted

Thank you so much @Jerry Fiedler.

Said by you, those words are an honor for me.

 

I think we still need to find the "orthodox" way to do the calculations.

For example:

MoreChords.thumb.png.22dcfb758bce40267b224191f7e93d3c.png

  • Like 1
Posted

@GLAVCVS nice code re front end could a DCl that asks how many chords then pops a child dcl or new dcl with edit boxes to enter the chord values. This image is dummied up. 

image.png.197d59696a83fff01b5c18ae26d3a727.png

Would use Multi getval.lsp for the multiple answers as you just make a list and the dcl is auto generated.

 

; the input box size can be bigger just change the two values tetsed with 145 145 and worked ok.
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans1 (AH:getvalsm (list "How many chords " "chords" 5 4 "3" )))
(setq ans2 (AH:getvalsm (list "Enter values " "chord1" 5 4 "" "chord2" 5 4 "" "chord3" 5 4 "")))

; (setq ans2 (AH:getvalsm lst))

 

  • Like 1
Posted

 

On 5/14/2025 at 10:43 AM, GLAVCVS said:

PS: A tool like this, contrary to what @Eldon thinks, if it becomes an option available to a designer or architect, I think it could be used frequently over time.

 

; Made for https://www.cadtutor.net/forum/topic/97799 14/05/2025 
;                                                                
;******** << E x t r a v a g a n t   C h o r d s  V.1 >> ********
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:ExtravagantChords (/ para in sc lCs op errores error0)
  (defun errores (mens)
    (setq *error* error0)
    (prin1)
  )
  (defun obtPtsCuerdas (lCds op / p1 p2 p3 p4 radio dameAng dameASubt d1 d2 v f ab T1 T2 pR rf1 rf2 ct r ld pa b x p o le1 le2 s1 s2 px1 px2 les)
    (defun radio (aT lc / Rmin Rmax R1/2 tl ta dameAngulos); donde 'aT' es el angulo del arco a 'acordar' y 'lc' la lista de las longitudes de las cuerdas a aplicar
      (defun dameAngulos (R / a); obtenemos suma total de los arcos subtendidos
        (apply '+ (mapcar '(lambda (L) (* 2 (atan (setq a (/ L (* 2.0 R))) (sqrt (- 1.0 (* a a)))))) lc))
      )
      (setq Rmin (/ (apply 'max lc) 2.0)	; radio mínimo posible
  	    Rmax 1e6			; radio máximo arbitrario
	    tl   1e-12			; tolerancia
      )
      (while (> (- Rmax Rmin) tl); Búsqueda por bisección
        (if (> (dameAngulos (setq R1/2 (/ (+ Rmin Rmax) 2.0))) aT)
          (setq Rmin R1/2)			; el radio es demasiado pequeño
          (setq Rmax R1/2)			; el radio es demasiado grande
        )
      )
      (/ (+ Rmin Rmax) 2.0); Devolvemos el promedio del rango de radios posibles encontrados
    )
    (defun actEs (/ l r so ls l?)
      (foreach l (list (list px1 (car le1) d1) (list px2 (car le2) d2))
        (setq r (equal (distance (car l) (cdr (assoc 10 (setq ls (entget (cadr l)))))) 0. 1e-6)
          l? (= (cdr (assoc 0 ls)) "LINE") 
	      so (if (equal (caddr l) (angle v (car o)) 1e-6) (car o) (last o))
        )
        (entmod (subst (cons (if (and l? (not r)) 11 10) so) (assoc (if (and l? (not r)) 11 10) (if r ls (reverse ls))) ls))
      )
    )
    (defun dameAng (p1 p2 p3 p4 / f) ; ESTA FUNCION SIEMPRE DEVUELVE EL ANGULO INFERIOR A PI
      (if (> (setq f (abs (- (angle p1 p2) (angle p3 p4)))) pi) (- (* 2 pi) f) f)
    )
    (defun dameASubt (l r / a) ; devuelve el arco subtendido para la cuerda de longitud l sobre el arco de radio r
      (* 2.0 (atan (setq a (/ l (* 2.0 r))) (sqrt (- 1.0 (* a a)))))
    )
    (defun os (le / x pk tm f d p i s a b tam)
      (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))))
      (while (and
	       (if x x (setq x (entget (car le)) pk (if (= (cdr (assoc 0 x)) "LWPOLYLINE") (cadr le)) b t))
               (setq f (cdr (assoc (if pk 10 11) (setq x (cdr (member (setq p (assoc 10 x)) x))))))
	       (if pk (not (inters f (cdr p) (polar pk (+ (setq a (angle f (cdr p))) 1.5708) tam) (polar pk (- a 1.5708) tam))))
             )
      )
      (list (cdr p) f)
    )
    (if (setq s1 (os (setq le1 (entsel "\nSelect FIRST segment..."))))
      (if (setq s2 (os (setq le2 (entsel "\nSelect SECOND segment..."))))
        (if (setq v (inters (setq p1 (car s1)) (setq p2 (cadr s1)) (setq p3 (car s2)) (setq p4 (cadr s2)) nil));(inters p1 p2 p3 p4 nil))
          (setq d1 (if (< (distance V p1) (distance V p2)) (angle (setq px1 p1) p2) (angle (setq px1 p2) p1)) ;d1 es la direccion del primer segmento
	        d2 (if (< (distance V p3) (distance V p4)) (angle (setq px2 p3) p4) (angle (setq px2 p4) p3)) ;d2 es la direccion del segundo segmento
	        f (if (> (setq f (abs (- d1 d2))) pi) (- (* 2 pi) f) f) ;aseguramos angulo minimo. f es el angulo incluido entre las 2 lineas
	        ab (+ ((if (> (abs (- d1 d2)) PI) max min) d1 d2) (/ f 2.0)) ;angulo bisectriz
	        T1 (inters V (polar V d1 10000) (setq pR (polar V ab 100)) (polar pR (+ d1 (/ pi 2)) 10000) nil) ;punto tangente 1 (temporal para cálculos previos)
	        T2 (inters V (polar V d2 10000) pR (polar pR (+ d2 (/ pi 2.0)) 10000) nil) ;punto tangente 2 (temporal para cálculos previos)
	        ct (inters T1 (polar T1 (+ d1 (/ pi 2)) 100) v (polar v ab 100) nil) ; calculamos centro (temporal para cálculos previos)
	         r (radio (dameAng ct T1 ct T2) lCds) ;radio necesario para encajar las cuerdas
	        ld (/ r (/ (sin (/ f 2.0)) (cos (/ f 2.0)))) ; calculamos el cateto largo hasta el punto tangente del arco
	        ct (inters (setq pa (polar v d1 ld)) (polar pa (+ d1 (/ pi 2)) 100) v (polar v ab 100) nil) ; calculamos el centro del arco
	        rf1 (angle pR T1)
	        rf2 (angle pR T2)
	        b ((if (> (abs (- rf1 rf2)) PI) max min) rf1 rf2) ; angulo base para obtener puntos de cuerdas por polares
	        x (foreach c lCds
	            (setq o (cons
			      (polar ct (if (> (setq g (+ b (dameASubt c r)) ) 6.2831853) (- g 6.2831853) g) r)
			      (if o o (list (polar ct b r)))
		            )
		          b g
	            )
		  )
		x (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbPolyline") (cons 90 (length o))) (mapcar '(lambda(x) (cons 10 x)) o)))
	        x (if op (actEs))
          )
        )
      )
    )
    (princ)
  )
  (setq error0  *error*
	*error* errores
  )
  (while (not para)
    (setq sc (getreal (strcat "\rIndicate length CHORD number " (itoa (setq in (if in (1+ in) 1))) " (CounterClockWise) (or ENTER to finish): ")))
    (if sc
      (setq lCs (append lcs (list sc)))
      (setq para T)
    )
  )
  (while (not (member (strcase (setq op (getstring "\rDo you want to snap lines/lwpolylines to calculated chords? <YES>/NO: "))) '("" "Y" "N")))
    (princ "\n*** Invalid option. Try again (ENTER, Y or N)... ***")
  )
  (obtPtsCuerdas lCs (if (= op "N") nil T))
  (princ)
)

 

I apologize for not translating the comments.

 

I definitely believe that when a new, accessible tool is available that offers new possibilities, it ends up being used repeatedly.

Posted
34 minutes ago, Vica said:

 

I definitely believe that when a new, accessible tool is available that offers new possibilities, it ends up being used repeatedly.

 

I hope you are able to keep tally on the number of downloads and usage to quantify your assertion.

Posted (edited)
8 hours ago, BIGAL said:

@GLAVCVS nice code re front end could a DCl that asks how many chords then pops a child dcl or new dcl with edit boxes to enter the chord values. This image is dummied up. 

image.png.197d59696a83fff01b5c18ae26d3a727.png

Would use Multi getval.lsp for the multiple answers as you just make a list and the dcl is auto generated.

 

; the input box size can be bigger just change the two values tetsed with 145 145 and worked ok.
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans1 (AH:getvalsm (list "How many chords " "chords" 5 4 "3" )))
(setq ans2 (AH:getvalsm (list "Enter values " "chord1" 5 4 "" "chord2" 5 4 "" "chord3" 5 4 "")))

; (setq ans2 (AH:getvalsm lst))

 

 

Thanks @BIGAL
I'm not familiar with the possibilities of MultiGetvals.
I think it would be appropriate to combine everything into a single box:
- A 'list_box' occupying the left half of the box
- A 'boxed_column' occupying the right half. Within this element, it would be necessary to study how to distribute two 'radio_buttons' to select identical or different chords, a 'text_box' to indicate the number of chords (which is enabled or disabled depending on the option selected in the radio_buttons), a 'text_box' to enter the chord lengths, a button to store/insert the length indicated in the previous 'text_box' into the 'list_box', another button to perform the calculation with the specified parameters and exit, and another button to Cancel.
Surely an 'err_tile' should be left somewhere to explain possible errors to the user.

Edited by GLAVCVS
Posted (edited)

Here is multi getvals.lsp. The reason I mention it as you do not know how many chords are to be entered. Using a dcl over a while has advantage can double check values before pressing OK.

 

The way to go would be to pop a child dcl over the top of the enter number of chords DCL.

 

I have sent you a pm. There is multiple make dcls, have a play. re radio buttons Multi radio buttons.lsp.

 

Maybe enter number of chords as a -ve then only enter 1 size is required next.

 

Multi GETVALS.lsp

Edited by BIGAL

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...