Raccord en épingle à cheuveux

[bonuscad]

J'ai vu cette demande dans un forum US.

J'ai trouvé le challenge intéressant (réécrire une commande raccord)

 

Après ne nombreux tests et ce n'est pas encore parfait (parfois; problème de mise en place dans des SCU non parallèles), mais déjà bien aboutie ,je trouve.

 

Si certains veulent essayer d'aller plus loin... pour le "fun" ;)

 

(defun ang_x (px p1 p2 / l_pt l_d p ang)
(setq
	l_pt (mapcar '(lambda (x) (list (car x) (cadr x))) (list px p1 p2))
	l_d (mapcar 'distance l_pt (append (cdr l_pt) (list (car l_pt))))
	p (/ (apply '+ l_d) 2.0)
	ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0)
)
)
(defun det_wh (px p1 p2 / v1 v2 det_or)
(setq
	v1 (mapcar '- p2 p1)
	v2 (mapcar '- px p1)
)
(if (> (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2)) 0.0) 1 -1)
)
(defun k_th (p1 p2 c / k)
(setq k (/ c (distance p1 p2)))
(mapcar '+ (mapcar '* (mapcar '- p2 p1) (list k k k)) p1)
)
(defun c:bubble_fillet ( / js1 js2 ps1 ps2 pt_lst pt l3 key_fillet alpha chord p_o a1 a2)
(princ "\nSélectionnez la première ligne: ")
(while (or (null (setq js1 (entsel))) (/= (cdr (assoc 0 (entget (car js1)))) "LINE")))
(princ "\nSélectionnez la deuxième ligne: ")
(while (or (null (setq js2 (entsel))) (/= (cdr (assoc 0 (entget (car js2)))) "LINE")))
(setq
	ps1 (trans (cadr js1) 1 0)
	ps2 (trans (cadr js2) 1 0)
	js1 (entget (car js1))
	js2 (entget (car js2))
	pt_lst (list (cdr (assoc 10 js1)) (cdr (assoc 11 js1)) (cdr (assoc 10 js2)) (cdr (assoc 11 js2)))
	pt (inters (car pt_lst) (cadr pt_lst) (caddr pt_lst) (cadddr pt_lst) nil)
)
(cond
	((and pt (equal (assoc 210 js1) (assoc 210 js2) 1E-8))
		(if (eq (det_wh (cadddr pt_lst) (car pt_lst) (cadr pt_lst)) (det_wh (caddr pt_lst) (car pt_lst) (cadr pt_lst)))
			(if (> (distance pt (caddr pt_lst)) (distance pt (cadddr pt_lst)))
				(setq l3 (list pt (caddr pt_lst)))
				(setq l3 (list pt (cadddr pt_lst)))
			)
			(if (eq (det_wh ps2 (car pt_lst) (cadr pt_lst)) (det_wh (caddr pt_lst) (car pt_lst) (cadr pt_lst)))
				(setq l3 (list pt (caddr pt_lst)))
				(setq l3 (list pt (cadddr pt_lst)))
			)
		)
		(if (eq (det_wh (cadr pt_lst) (caddr pt_lst) (cadddr pt_lst)) (det_wh (car pt_lst) (caddr pt_lst) (cadddr pt_lst)))
			(if (> (distance pt (car pt_lst)) (distance pt (cadr pt_lst)))
				(setq l3 (cons (car pt_lst) l3))
				(setq l3 (cons (cadr pt_lst) l3))
			)
			(if (eq (det_wh ps1 (caddr pt_lst) (cadddr pt_lst)) (det_wh (car pt_lst) (caddr pt_lst) (cadddr pt_lst)))
				(setq l3 (cons (car pt_lst) l3))
				(setq l3 (cons (cadr pt_lst) l3))
			)
		)
		(initget 4)
		(setq key_fillet
			(getdist
				(strcat
					"\nSpécifiez le rayon du raccord [b]<[/b]"
					(rtos (getvar "FILLETRAD"))
					">:"
				)
			)
		)
		(if (null key_fillet) (setq key_fillet (getvar "FILLETRAD")) (setvar "FILLETRAD" key_fillet))
		(setq
			alpha (ang_x (cadr l3) (car l3) (caddr l3))
			chord (/ (* (getvar "FILLETRAD") (sin (- pi alpha))) (sin (* alpha 0.5)))
			js1 (subst (cons 10 (car l3)) (assoc 10 js1) js1)
			js2 (subst (cons 10 (caddr l3)) (assoc 10 js2) js2)
		)
		(entmod (setq js1 (subst (cons 11 (k_th pt (car l3) chord)) (assoc 11 js1) js1)))
		(entmod (setq js2 (subst (cons 11 (k_th pt (caddr l3) chord))  (assoc 11 js2) js2)))
		(setq
			p_o (k_th pt (mapcar '* (mapcar '+ (cdr (assoc 11 js1)) (cdr (assoc 11 js2))) '(0.5 0.5 0.5)) (getvar "FILLETRAD"))
			a1 (angle p_o (cdr (assoc 11 js1)))
			a2 (angle p_o (cdr (assoc 11 js2)))
		)
		(entmake
			(list
				(cons 0 "ARC")
				(cons 100 "AcDbEntity")
				(assoc 67 js1)
				(assoc 410 js1)
				(cons 8 (getvar "CLAYER"))
				(if (assoc 62 js1) (assoc 62 js1) (cons 62 256))
				(if (assoc 6 js1) (assoc 6 js1) (cons 6 "BYLAYER"))
				(cons 38 (+ (cadddr (assoc 10 js1)) (getvar "ELEVATION")))
				(cons 39 (getvar "THICKNESS"))
				(cons 100 "AcDbCircle")
				(cons 10 (trans p_o 0 (cdr (assoc 210 js1))))
				(cons 40 (getvar "FILLETRAD"))
				(assoc 210 js1)
				(cons 100 "AcDbArc")
				(cons 50
					(if (equal (* (+ (max a1 a2) (min a1 a2)) 0.5) (angle p_o pt) 1E-8)
						(min a1 a2)
						(max a1 a2)
					)
				)
				(cons 51
					(if (equal (* (+ (max a1 a2) (min a1 a2)) 0.5) (angle p_o pt) 1E-8)
						(max a1 a2)
						(min a1 a2)
					)
				)
			)
		)
	)
	(T
		(princ "\nNe peut raccorder des lignes dans des plans différents!")
	)
)
(prin1)
)

[Matt666]

Il est fou Bonuscad, il est fou !! :)

 

la vache ! Bah écoute, cool !

 

J'avais recréé (partiellement) la commande ligne.. Mais la commande raccord, c'est une autre paire de manche !!

 

Ca peut être marrant.

 

A bientot !

Matt.