Community Challenges

Les cercles magiques en AutoLISP

Proposition de didier un peu en retard

Bonjour,

 

Je vous propose cette autre façon de d'attaquer le problème.

  1. Puisqu'on bénéficie du théorème de Descartes, on peut calculer le rayon d'un cercle tangent à trois autres.
  2. Puisqu'on connaît la position de trois centres, je calcule par intersection de deux cercles le centre du futur cercle.
    Certes, il y a deux solutions à cette intersection :

Snag_4dc9670.png

Je choisis la bonne en vérifiant les distances au cercle principal.

Ensuite, je lance des boucles et c'est là que je me perds n'ayant pas le niveau des autres concurrents.

De ce fait, je ne fais pas d'autres calculs que des cercles tangents au cercle englobant, je pense retravailler le code pour faire mieux, mais plus tard...

J'ai aussi une version avec textes des inverses des rayons pour notifier les nombres entiers.

Amicalement

Screencast

(defun intcer (c1 c2 rc1 rc2 / a h )
    (setq d (distance c1 c2))
    (setq a (/ (+ (- (expt rc1 2) (expt rc2 2)) (expt d 2)) (* 2.0 d))
          h (sqrt (- (expt rc1 2) (expt a 2)))
          pa (polar c1 (angle c1 c2) a)
          )
    (list (polar pa (+ (angle c1 c2) (/ pi 2)) h)
          (polar pa (- (angle c1 c2) (/ pi 2)) h)
          )    
    );fin defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun calr (r1 r2 r3 /)
    (/ (* r1 r2 r3) (- (+ (* r1 r2)(* r2 r3)(* r1 r3))(* 2 (sqrt (* (* r1 r2 r3)(+ r1 r2 r3))))))
    );fin de calcul du rayon du cercle tangents aux trois cercles de rayon r1 r2 r3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun descer (centre rayon couleur / ); dessin d'un cercle 3 arguments
    (entmakex (list (cons 0 "CIRCLE") (cons 62 couleur)(cons 10 centre) (cons 40 rayon)))
    )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun da-magic (cen1 / cen1 cen2 cen2sauv cen3 cen3sauv cen4 cer1 cer2 cer3 dx dy el int li li2 li3 lp n p2 p3 p4 prof pt r r1 r2 r3)
    
    (setq prof 12 	;nombre de cercles d'un côté du premier cercle
          r1 1  	;rayon bloqué du premier cercle
          )

    (setq cer1 (descer cen1 r1 6))
    (setq r2 (/ r1 2.0))
    (entmake (list (cons 0 "CIRCLE")(cons 62 3)(cons 10 (list (- (car cen1) 0.50) (cadr cen1))) (cons 40 r2)))
    (setq cen2 (list (+ (car cen1) 0.50) (cadr cen1)(caddr cen1))
          cen2sauv cen2)
    (setq cer2 (descer cen2 r2 3))
    (setq r3 (/ r1 3.0))
    (entmake (list (cons 0 "CIRCLE")(cons 62 4)(cons 10 (list (car cen1) (+ (cadr cen1) (/ 2.0 3.0)) (cadr cen1))) (cons 40 r3)))
    (setq cen3 (list (car cen1) (- (cadr cen1)(/ 2.0 3.0)) (caddr cen1))
          cen3sauv cen3)
    (setq cer3 (entmakex (list (cons 0 "CIRCLE")(cons 62 4)(cons 10 (list (car cen1) (- (cadr cen1) (/ 2.0 3.0)) (cadr cen1))) (cons 40 r3))))
    (setq r1 -1)
    (setq li nil)
    ;;;;;;;;;;;;;;;;;;;;;;;;
    (setq r (calr r1 r2 r3))
    (setq int (intcer cen2 cen3 (+ r2 r) (+ r3 r)))
    (if (equal (distance cen1 (car int)) (* -1 (+ r r1)) 0.00001)
        (setq cen4 (car int))
        (setq cen4 (cadr int))
        )
    (setq li (cons (list cen4 r) li))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (repeat 2 ;une fois à droite une fois à gauche
        (repeat prof
            (setq r3 (last (car li)))
            (setq cen3 (car (car li)))
            (setq r (calr r1 r2 r3))
            (setq int (intcer cen2 cen3 (+ r2 r) (+ r3 r)))
            (if (equal (distance cen1 (car int)) (* -1 (+ r r1)) 0.00001)
                (setq cen4 (car int))
                (setq cen4 (cadr int))
                )
            (setq li (cons (list cen4 r) li))
            );fin du repeat prof
        (setq r1 -1
              r3 0.5
              r2 (/ 1.0 3.0)
              cen3 cen2sauv
              cen2 cen3sauv
              li (reverse li)
              )
        );fin du premier tour droite gauche
    (foreach el li (descer (car el) (last el) 22))
    (foreach el li
        (setq dx (* 2 (abs (- (car (car el)) (car cen1))))
              dy (* 2 (abs (- (cadr(car el)) (cadr cen1))))
              p2 (polar (car el) (/ pi 2) dy)
              p3 (polar p2 pi dx)
              p4 (polar p3 (+ pi (/ pi 2)) dy)
              )
        (setq lp (list p2 p3 p4))
        (mapcar '(lambda (pt) (entmake (list '(0 . "CIRCLE")(cons 62 22) (cons 10 pt) (cons 40 (last el)))))lp)
        )
    ;;;;;;;;;;
    (setq li2 (vl-sort li (function (lambda (e1 e2) (< (car (car e1)) (car (car e2)))))))
    (setq n 0)
    (repeat (- (length li2) 1)
        (setq r (calr -1 (last (nth n li2)) (last (nth (+ 1 n) li2))))
        (setq int (intcer (car (nth n li2)) (car (nth (+ 1 n) li2)) (+ (last (nth n li2)) r) (+ (last (nth (+ 1 n) li2)) r)))
        (if (equal (distance cen1 (car int)) (* -1 (+ r r1)) 0.00001)
            (setq cen4 (car int))
            (setq cen4 (cadr int))
        )        
        (setq li3 (cons (list cen4 r) li3))
        (setq n (+ 1 n))
        )
    (foreach el li3 (descer (car el) (last el) 2))
    (foreach el li3
        (setq dx (* 2 (abs (- (car (car el)) (car cen1))))
              dy (* 2 (abs (- (cadr(car el)) (cadr cen1))))
              p2 (polar (car el) (/ pi 2) dy)
              p3 (polar p2 pi dx)
              p4 (polar p3 (+ pi (/ pi 2)) dy)
              )
        (setq lp (list p2 p3 p4))        
        (mapcar '(lambda (pt) (entmake (list '(0 . "CIRCLE")(cons 62 2) (cons 10 pt) (cons 40 (last el)))))lp)
        )
    );fin defun da-magic
(defun c:test ()
    (setq cen1 (getpoint "\nCentre du cercle initial\n"))
    (da-magic cen1)
    )


    
    

 

 

 

 

0 Comments