Circle (lisp) routine in autocad

[gordonired]

Yes I'm replying to a 10 year old thread, here's hoping someone has been able to get this to work recently. I'm in Autocad 2023, trying to get this lsp to work. I've shot in 4 bolts on a flange with a total station, and brought the data into Autocad. The smallest deviation in height exists, but I want to fit a circle of known diameter to these points to try and get my centre of pipe.

The error autocad is throwing at me is "malformed list on input". A quick google search is telling me this is likely a bracket not being closed at some point. Finding a bracket is easy, but learning how the code works isn't all that easy for me at least. Does it work for anyone else? Does anyone have an alternate solution after all these years?

[Tanguy Nédélec]

Add a closing parenthesis at the very end of Andrew's code

[gordonired]

Add a closing parenthesis at the very end of Andrew's code

That fixed it. The circle isn't drawn on the same plane, it ends up at elevation 0 on my drawing. Small issue for someone to fix who has time.

[Tanguy Nédélec]

There you go. This should work for every UCS and ELEVATION variable value. The points must be in the XY plane of the current UCS (or a plane parallel to it).

EDIT : more accurately, the points can be in any plane (or not be coplanar at all), but the best fit will be computed from their projection on the current XY plane.

Code: Select all

(PRINC
  "\nFit circle to points Version 1.0, type FC2P to run "
)

(DEFUN C:FC2P (/)

  (SETQ aws (SSGET '((0 . "POINT"))))

  (SETQ POINTLIST NIL)
  (SETQ COUNT 0)
  
  ;CREATE POINT LIST
  (REPEAT (SSLENGTH aws)
	(SETQ P1 (CDR (ASSOC 10 (ENTGET (SSNAME aws COUNT)))))
	(SETQ P1 (TRANS P1 0 1))
	(SETQ POINTLIST (APPEND POINTLIST P1))
	(SETQ COUNT (+ COUNT 1))
  ) ; ende repeat

  ;GET SUM AND AVERAGE FOR U,V VALUES
  (SETQ SUMX 0)
  (SETQ SUMY 0)
  (SETQ COUNT 0)
  (SETQ N (/ (LENGTH POINTLIST) 3))
  (REPEAT N

	(SETQ X (NTH COUNT POINTLIST))
	(SETQ COUNT (+ COUNT 1))
	(SETQ Y (NTH COUNT POINTLIST))
	(SETQ COUNT (+ COUNT 1))
	(SETQ COUNT (+ COUNT 1))
	(SETQ SUMX (+ SUMX X))
	(SETQ SUMY (+ SUMY Y))
  )

  (SETQ AVGX (/ SUMX N))
  (SETQ AVGY (/ SUMY N))

  ;CREATE UVLIST WITH MULTIPLES AND SUMS
  (SETQ UVLIST NIL)
  (SETQ	SUU	0
		SVV	0
		SUV	0
		SUUU 0
		SVVV 0
		SUVV 0
		SVUU 0
  )


  (SETQ COUNT 0)
  (REPEAT N
	(SETQ U (- (NTH COUNT POINTLIST) AVGX))
	(SETQ COUNT (+ COUNT 1))
	(SETQ V (- (NTH COUNT POINTLIST) AVGY))
	(SETQ COUNT (+ COUNT 1))
	(SETQ COUNT (+ COUNT 1))
	(SETQ UU (* U U))
	(SETQ VV (* V V))
	(SETQ UV (* U V))
	(SETQ UUU (* U U U))
	(SETQ VVV (* V V V))
	(SETQ UVV (* U V V))
	(SETQ VUU (* V U U))
	(SETQ SUU (+ SUU UU))
	(SETQ SVV (+ SVV VV))
	(SETQ SUV (+ SUV UV))
	(SETQ SUUU (+ SUUU UUU))
	(SETQ SVVV (+ SVVV VVV))
	(SETQ SUVV (+ SUVV UVV))
	(SETQ SVUU (+ SVUU VUU))
  )



  ;CREATE A MATRIX
  (SETQ A11 SUU)
  (SETQ A12 SUV)
  (SETQ A21 SUV)
  (SETQ A22 SVV)

  ;CREATE B MATRIX
  (SETQ B1 (/ (+ SUUU SUVV) 2))
  (SETQ B2 (/ (+ SVVV SVUU) 2))

  ;CREATE ATA
  (SETQ ATA11 (+ (* A11 A11) (* A12 A21)))
  (SETQ ATA12 (+ (* A11 A12) (* A12 A22)))
  (SETQ ATA21 (+ (* A21 A11) (* A22 A21)))
  (SETQ ATA22 (+ (* A21 A12) (* A22 A22)))

  ;DETERMINE DETERMINANT
  (SETQ DET (- (* ATA11 ATA22) (* ATA12 ATA21)))
  (SETQ DET (/ 1 DET))
  (SETQ INV11 (* -1 (* DET ATA22)))
  (SETQ INV12 (* -1 (* (* DET ATA12) -1)))
  (SETQ INV21 (* -1 (* (* DET ATA21) -1)))
  (SETQ INV22 (* -1 (* DET ATA11)))

  ;CREATE ATB
  (SETQ ATB1 (+ (* A11 B1) (* A12 B2)))
  (SETQ ATB2 (+ (* A21 B1) (* A22 B2)))

  ;CREATE X
  (SETQ X1 (+ (* INV11 ATB1) (* INV12 ATB2)))
  (SETQ X2 (+ (* INV21 ATB1) (* INV22 ATB2)))

  (SETQ CX (+ (* X1 -1) AVGX))
  (SETQ CY (+ (* X2 -1) AVGY))

  (COMMAND "_POINT" (LIST CX CY))
  (SETQ NRAD (SQRT (+ (* X1 X1) (* X2 X2) (/ (+ SUU SVV) N))))

  (PRINC (STRCAT "\nNominal Radius " (RTOS NRAD 2 4)))
  (SETQ RAD (GETREAL "\nDesign Radius: "))

  (COMMAND "_CIRCLE" (LIST CX CY) RAD)

  (SETQ COUNT 0)
  (REPEAT (SSLENGTH aws)
	(SETQ P1 (trans (CDR (ASSOC 10 (ENTGET (SSNAME aws COUNT)))) 0 1))
	(SETQ DIFF (- RAD (DISTANCE P1 (LIST CX CY))))
	(COMMAND "_TEXT" P1 "0.025" "90" (RTOS DIFF 2 4))
	(SETQ COUNT (+ COUNT 1))
  )	; ende repeat

)