_

Lisp obliczający środek okręgu z punktów

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

Lisp obliczający środek okręgu z punktów

Postprzez Leszek Modzelewski » maja 06, 2022 07:11

Witam

Ten lisp nie jest mój, znalazłem go na innym forum i chciałbym go poprawić ale nie wiem jak.
Działa to tak - wybieram zbiór punktów i dostaje obliczony punkt środkowy wraz z odchyłkami od obliczonego promienia. Działa idealnie gdy punkty są na tej samej wysokości. Przy każdym punkcie są podawane odchyłki problem polega na tym, że wartości są przestrzenne czyli od punktu obliczonego. W przypadku gdy jeden punkt jest wyżej lub niżej cad podaje wartości "skośne". Jak to poprawić? Obliczenie środka jest poprawne tylko wartości obok punktów są błędne.

(defun c:fc (/ *AcadDoc* *error* a avg b cen cu cv dif diff errl m n p pl rad res s ss sum x)
(vl-load-com)
(defun *error* (msg)
(mapcar 'eval errl)
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
(princ (strcat "\nError: " msg))
)
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(princ)
)

(setq errl '("CMDECHO" "DIMZIN")
errl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) errl)
)


(or *AcadDoc*
(setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
)

(princ (strcat "\n Select Points"))
(if (setq n 0
pl nil
ss (ssget '((0 . "POINT")))
go (> (sslength ss) 2)
)
(progn
(vla-startundomark *AcadDoc*)
(setvar 'CMDECHO 0)
(setvar 'DIMZIN 0)
(repeat (sslength ss)
(setq pl (cons (cdr (assoc 10 (entget (ssname ss n)))) pl)
n (1+ n)
)
)
(setq avg (mapcar '/ (apply 'mapcar (cons '+ pl)) (list n n n))
dif (mapcar '(lambda (a) (mapcar '- a avg)) pl)
sum (apply
'mapcar
(cons '+
(mapcar
'(lambda (a)
(list (* (car a) (car a))
(* (car a) (cadr a))
(* (cadr a) (cadr a))
(* (car a) (car a) (car a))
(* (car a) (cadr a) (cadr a))
(* (car a) (car a) (cadr a))
(* (cadr a) (cadr a) (cadr a))
)
)
dif
)
)
)
;; sum contains: (sUU sUV sVV sUUU sUVV sUUV sVVV) ;
a (list (car sum) (cadr sum) (/ (+ (cadddr sum) (car (cddddr sum))) 2))
b (list (cadr sum) (caddr sum) (/ (+ (cadr (cddddr sum))(caddr (cddddr sum))) 2))
m (/ (car a) (car b))
s (mapcar '- a (mapcar '(lambda (x) (* x m)) b))
y0 (/ (caddr s) (cadr s))
x0 (/ (- (caddr a) (* (cadr a) y0)) (car a))
r0 (sqrt (+ (* x0 x0) (* y0 y0) (/ (+ (car sum) (caddr sum)) n)))
x0 (+ x0 (car avg))
y0 (+ y0 (cadr avg))
n (1- n)
)

(setq corr 9999999999
tol 1e-06
astep 0
areport "Circular Non-Linear Regression Results \n"
)
(princ (strcat aReport "\n"
" Initial: " (itoa aStep) "\n"
" Xo: " (rtos x0 2 8) "\n"
" Yo: " (rtos y0 2 8) "\n"
" R : " (rtos r0 2 8) "\n\n")
)
(while (and (< astep 21) (> corr tol))
(setq astep (1+ astep)
a00 0.0 a01 0.0 a02 0.0 a03 0.0
a10 0.0 a11 0.0 a12 0.0 a13 0.0
a20 0.0 a21 0.0 a22 0.0 a23 0.0
)
(foreach p pl
(setq x (car p) y (cadr p))
(setq bott (sqrt(+ (* x x) (* -2.0 x x0) (* y y)(* -2.0 y0 y) (* x0 x0)(* y0 y0)))
k1 (sqrt (+ (*(- x x0)(- x x0)) (* (- y y0) (- y y0))))
a (/ (- x0 x) bott)
b (/ (- y0 y) bott)
c -1.0
k (- 0.0 (- k1 r0))
a00 (+ a00 (* a a)) ; A*Sum(A**2)+B*2Sum(AB) +C*Sum(AC) +Sum(AK) =0
a01 (+ a01 (* a b)) ; A*Sum(AB) +B*2Sum(B**2)+C*Sum(BC) +Sum(BK) =0
a02 (+ a02 (* a c)) ; A*Sum(AC) +B*2Sum(BC) +C*Sum(C**2)+Sum(-K) =0
a03 (+ a03 (* a k))
a11 (+ a11 (* b b))
a12 (+ a12 (* b c))
a13 (+ a13 (* b k))
a22 (+ a22 (* c c))
a23 (+ a23 (* -1. k))
)
)
(setq a10 a01 a20 a02 a21 a12)
(setq MatA (list (list a00 a01 a02 a03)
(list a10 a11 a12 a13)
(list a20 a21 a22 a23)
)
MatR (Gauss MatA)

c (/ (last (last MatR)) (caddr(last MatR)))
b (/ (- (last (cadr MatR)) (* (caddr (cadr MatR)) c)) (cadr(cadr MatR)))
a (/ (- (last (car MatR)) (* (cadr (car MatR)) b) (* (caddr (car MatR)) c)) (car(car MatR)))
corr (min (max (abs a)(abs b)(abs c)) corr)
x0 (+ x0 a)
y0 (+ y0 b)
r0 (+ r0 c)

)
(setq aReport (strcat "\n"
"Iteration: " (itoa aStep) "\n"
" Xo: " (rtos x0 2 8) "\n"
" Yo: " (rtos y0 2 8) "\n"
" R : " (rtos r0 2 8) "\n\n"
" Matrix : " (rtos a00 2 3) " " (rtos a01 2 3) " " (rtos a02 2 3) " " (rtos a03 2 3) "\n"
" " (rtos a10 2 3) " " (rtos a11 2 3) " " (rtos a12 2 3) " " (rtos a13 2 3) "\n"
" " (rtos a20 2 3) " " (rtos a21 2 3) " " (rtos a22 2 3) " " (rtos a23 2 3) "\n\n"
" Delta X: " (rtos a 2 8) "\n"
" Delta Y: " (rtos b 2 8) "\n"
" Delta R: " (rtos c 2 8) "\n\n"
)
)
(princ aReport)
(setq aReport "")
)
(entmakex (list '(0 . "POINT") (cons 10 (list x0 y0))))
(entmakex (list '(0 . "CIRCLE") (cons 10 (list x0 y0)) (cons 40 r0)))
(foreach p pl
(setq ;p (cdr (assoc 10 (entget (ssname ss n))))
res (- r0 (distance p (list x0 y0)))
n (1- n)
)
(entmakex (list '(0 . "TEXT") '(8 . "Residuals") (cons 10 p) (cons 40 100.0) '(50 . 1.5708) (cons 1 (rtos res 2 0))))
)
)
)
)

;*****************************************************************************;
;; gauss ;
;; Implementation Gaussian Elimination by ElpanovEvgeniy ;
;; For text: 1x+2y+3z=2 ;
;; 10x+1y+8z=17 ;
;; 7z+2y=5 ;
;; (gauss '((1.0 2.0 3.0 2.0) (10.0 1.0 8.0 17.0) (0.0 2.0 7.0 5.0))) ;
;; => ;
;; ((1.0 2.0 3.0 2.0) (0.0 -19.0 -22.0 -3.0) (0.0 0.0 4.68421 4.68421)) ;
;;****************************************************************************;

(defun gauss (lst)

(if (car lst)
(if (zerop (caar lst))
(if (vl-every (function zerop) (mapcar (function car) lst))
(if (cdr lst)
(cons
(car lst)
(mapcar
(function (lambda (x) (cons 0. x)))
(gauss (mapcar (function cdr) (cdr lst)))
)
)
lst
)
(gauss
(cons
(mapcar
(function +)
(car lst)
(car (vl-remove-if
(function (lambda (x) (zerop (car x))))
(cdr lst)
)
)
)
(cdr lst)
)
)
)
(cons
(car lst)
(mapcar
(function (lambda (x) (cons 0. x)))
(gauss
(mapcar
(function
(lambda (x / i)
(setq i (/ (car x) (caar lst)))
(mapcar
(function -)
(cdr x)
(mapcar (function (lambda (x1) (* x1 i)))
(cdar lst)
)
)
)
)
(cdr lst)
)
)
)
)
)
)
)
Leszek Modzelewski
 
Posty: 3
Dołączył(a): maja 06, 2022 06:55

Re: Lisp obliczający środek okręgu z punktów

Postprzez ziele_o2k » maja 11, 2022 00:29

Wrzuć dwga z przykładem (błąd / ok). Myślałem, że rozumiem o co chodzi, ale nie udało mi się odtworzyć błędu.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 813
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Lisp obliczający środek okręgu z punktów

Postprzez Leszek Modzelewski » maja 11, 2022 06:12

ziele_o2k napisał(a):Wrzuć dwga z przykładem (błąd / ok). Myślałem, że rozumiem o co chodzi, ale nie udało mi się odtworzyć błędu.


Wrzuciłem na idealnym okręgu - powinno na każdym punkcie wskazać 0 a na tym co ma wysokość 400 - pokazuje 23mm
Załączniki
FC.dwg
(101.32 KiB) Pobrane 19 razy
Leszek Modzelewski
 
Posty: 3
Dołączył(a): maja 06, 2022 06:55

Re: Lisp obliczający środek okręgu z punktów

Postprzez Leszek Modzelewski » maja 23, 2022 06:50

ziele_o2k napisał(a):Wrzuć dwga z przykładem (błąd / ok). Myślałem, że rozumiem o co chodzi, ale nie udało mi się odtworzyć błędu.


Nic nie da się zrobić? :?
Leszek Modzelewski
 
Posty: 3
Dołączył(a): maja 06, 2022 06:55

Re: Lisp obliczający środek okręgu z punktów

Postprzez ziele_o2k » maja 23, 2022 09:49

Leszek Modzelewski napisał(a):
ziele_o2k napisał(a):Wrzuć dwga z przykładem (błąd / ok). Myślałem, że rozumiem o co chodzi, ale nie udało mi się odtworzyć błędu.


Nic nie da się zrobić? :?


Zapomniałem odpisać. Nie mogę odtworzyć błędu na bricscadzie. Pewnie jest jakaś różnica w danych pobieranych z obiektów. Jak dorwę się do innego cada to może tam się uda. Nie wcześniej jak w przyszłym tygodniu coś pokombinuję.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 813
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań


Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników