Tracer un ARC avec pt de départ, rayon et un objet pour la tangente

bonuscad · le 27 mai 2006

J'ai essayer de créer une option de constuction d'arc comme définni dans le titre du post.

Les objet acceptés pour la tangence sont des lignes, arcs, cercles et des polylignes optimisées arrondies ou pas.

La routine fonctionne (normalement) dans des SCU paralèlles au SCG ET dans des SCU non parrallèle si celui ci est courrant (un problème persiste dans ce cas avec les arcs.)

Il reste certainement des imperfections ou des cas non prévus, mais la perfection devient complexe à mettre en oeuvre. Je pense qu'elle pourra répondre aux besoins les plus courants.

(vl-load-com)
(defun near_vertex_arr (obj / dxf_obj e_next obj_vlax pt_sel par pt_first pt_snd i bulge)
(setq dxf_obj (entget (car obj)))
(setq
		obj_vlax (vlax-ename->vla-object (car obj))
		pt_sel (osnap (cadr obj) "_near")
)
(if (null pt_sel)
		(progn
				(while (null (setq e_next (entsel "\nDétermination du segment imprécise, resélectionnez: "))))
				(setq pt_sel (osnap (cadr e_next) "_near"))
		)
)
(setq
		pt_sel (vlax-curve-getClosestPointTo obj_vlax (trans pt_sel 1 0))
		par (vlax-curve-getParamAtPoint obj_vlax pt_sel)
		pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
		pt_snd (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par))) 0 1)
		i 0
)
(while (or (/= (caar dxf_obj) 42) (if (< i (fix par)) (setq i (1+ i))))
		(setq bulge (cdadr dxf_obj) dxf_obj (cdr dxf_obj))
)
(list pt_first pt_snd bulge)
)
(defun c:arc_pt_rad_tg ( / z_dir pt_start rad e_cir ent dxf_ent p_10 p_11 straight l_2pt id_rad v1 v2 det_or dir test obj_line obj_cir lst_int pc1 pc2 pt_end1 pt_end2 ss1 ss2 key)
(setq z_dir (trans '(0 0 1) 1 0 T) dxf_ent nil)
(while (null dxf_ent)
		(while (null (setq ent (entsel "\nSélectionner l'objet pour la tangence de l'arc: "))))
		(setq dxf_ent (entget (car ent)))
		(if (or (not (member (cdr (assoc 0 dxf_ent)) '("LINE" "ARC" "CIRCLE" "LWPOLYLINE"))) (not (equal (cdr (assoc 210 dxf_ent)) z_dir 1E-8)))
				(progn (setq dxf_ent nil) (princ "\nN'est pas une ligne,arc, cercle ou lwpolyligne, ou non parrallèle au SCU courant!"))
		)
)
(cond
		((eq (cdr (assoc 0 dxf_ent)) "LINE")
				(setq p_10 (cdr (assoc 10 dxf_ent)))
				(setq p_11 (cdr (assoc 11 dxf_ent)))
				(setq straight T)
		)
		((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
				(setq l_2pt (near_vertex_arr ent))
				(if (zerop (caddr l_2pt))
						(setq
								p_10 (trans (car l_2pt) 1 0)
								p_11 (trans (cadr l_2pt) 1 0)
								straight T
						)
						(setq
								id_rad (/ (distance (car l_2pt) (cadr l_2pt)) (sin (* 2.0 (atan (caddr l_2pt)))) 2.0)
								p_10 (trans (polar
										(car l_2pt)
										(- (angle (car l_2pt) (cadr l_2pt)) (- (* 2 (atan (caddr l_2pt))) (/ pi 2)))
										id_rad
								) 1 0)
								straight nil
						)
				)
		)
		(T
				(setq p_10 (trans (cdr (assoc 10 dxf_ent)) (car ent) 0) id_rad (cdr (assoc 40 dxf_ent)) straight nil)
		)
)
(while (null pt_start)
		(initget 9)
		(setq pt_start (trans (getpoint "\nPoint de départ de l'arc: ") 1 0))
		(if (assoc 38 dxf_ent)
			(if (not (equal (+ (caddr (trans (list 0 0 0) 0 1)) (cdr (assoc 38 dxf_ent))) 0.0 1E-8))
				(setq pt_start (list (car pt_start) (cadr pt_start) (cdr (assoc 38 dxf_ent))))
			)
		)
		(cond
				(straight
						(setq
								v1 (mapcar '- p_10 p_11)
								v2 (mapcar '- p_10 pt_start)
								det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2))
						)
						(if (equal det_or 0.0 1E-8)
								(progn
										(princ "\nLe point de départ ne peut appartenir à la tangente")
										(setq pt_start nil)
								)
						)
				)
				(T
						(if (equal (polar (trans p_10 0 1) (angle (trans p_10 0 1) (trans pt_start 0 1)) id_rad) (trans pt_start 0 1) 1E-8)
								(progn
										(princ "\nLe point de départ ne peut appartenir à la tangente")
										(setq pt_start nil)
								)
						)
				)
		)
)
(initget 67)
(setq rad (getdist (trans pt_start 0 1) "\nRayon de l'arc: "))
(entmake
		(list
				(cons 0 "CIRCLE")
				(cons 100 "AcDbEntity")
				(cons 60 1)
				(cons 100 "AcDbCircle")
				(cons 10 (trans pt_start 0 z_dir))
				(cons 40 rad)
				(cons 210 z_dir)
		)
)
(setq e_cir (entlast) dxf_ent nil)
(cond
		(straight
				(cond
						((> det_or 0.0) (setq dir (+ (angle (trans p_10 0 1) (trans p_11 0 1)) (/ pi 2))))
						((< det_or 0.0) (setq dir (- (angle (trans p_10 0 1) (trans p_11 0 1)) (/ pi 2))))
				)
				(entmake
						(list
								(cons 0 "LINE")
								(cons 100 "AcDbEntity")
								(cons 60 1)
								(cons 100 "AcDbLine")
								(cons 10 (trans (polar (trans p_10 0 1) dir rad) 1 0))
								(cons 11 (trans (polar (trans p_11 0 1) dir rad) 1 0))
								(cons 210 z_dir)
						)
				)
				(if (inters (trans pt_start 0 1) (polar (trans pt_start 0 1) (+ dir pi) (* 2.0 rad)) (trans p_10 0 1) (trans p_11 0 1) T)
						(setq test T)
						(setq test nil)
				)
		)
		(T
				(if (>= (distance (trans p_10 0 1) (trans pt_start 0 1)) (abs id_rad))
						(setq id_rad (+ (abs id_rad) rad) det_or T)
						(setq id_rad (- (abs id_rad) rad) det_or nil)
				)
				(entmake
						(list
								(cons 0 "CIRCLE")
								(cons 100 "AcDbEntity")
								(cons 60 1)
								(cons 100 "AcDbCircle")
								(cons 10 (trans p_10 0 z_dir))
								(cons 40 (abs id_rad))
								(cons 210 z_dir)
						)
				)
				(if
						(or
								(> (distance (trans p_10 0 1) (trans pt_start 0 1)) (+ (abs id_rad) rad))
								(< (distance (trans p_10 0 1) (trans pt_start 0 1)) (- (abs id_rad) rad))
								(< (distance (trans p_10 0 1) (trans pt_start 0 1)) (- rad (abs id_rad)))
						)
						(setq test nil)
						(setq test T)
				)
		)
)
(cond
		(test
				(setq obj_line (vlax-ename->vla-object (entlast)))
				(setq obj_cir (vlax-ename->vla-object e_cir))
				(setq lst_int (vlax-variant-value (vla-IntersectWith obj_line obj_cir 1)))
				(entdel (entlast))
				(entdel e_cir)
				(cond
						((> (vlax-safearray-get-u-bound lst_int 1) 0)
								(setq lst_int (vlax-safearray->list lst_int))
								(setq pc1 (trans (list (nth 0 lst_int) (nth 1 lst_int) (nth 2 lst_int)) 0 1))
								(if (> (length lst_int) 3)
										(setq pc2 (trans (list (nth 3 lst_int) (nth 4 lst_int) (nth 5 lst_int)) 0 1))
										(setq pc2 pc1)
								)
								(if straight
										(setq
												pt_end1 (inters pc1 (polar pc1 dir rad) (trans p_10 0 1) (trans p_11 0 1) nil)
												pt_end2 (inters pc2 (polar pc2 dir rad) (trans p_10 0 1) (trans p_11 0 1) nil)
										)
										(if det_or
												(setq
														pt_end1 (polar pc1 (angle pc1 (trans p_10 0 1)) rad)
														pt_end2 (polar pc2 (angle pc2 (trans p_10 0 1)) rad)
												)
												(setq
														pt_end1 (polar pc1 (angle (trans p_10 0 1) pc1) rad)
														pt_end2 (polar pc2 (angle (trans p_10 0 1) pc2) rad)
												)
										)
								)
								(setvar "CMDECHO" 0)
								(setq old_osmd (getvar "osmode"))
								(setvar "osmode" 0)
								(if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
								(command "_.arc" "_ce" pc1 (trans pt_start 0 1) pt_end1)
								(setq ss1 (ssget "_L"))
								(command "_.arc" "_ce" pc1 pt_end1 (trans pt_start 0 1))
								(ssadd (entlast) ss1)
								(command "_.arc" "_ce" pc2 (trans pt_start 0 1) pt_end2)
								(setq ss2 (ssget "_L"))
								(command "_.arc" "_ce" pc2 pt_end2 (trans pt_start 0 1))
								(ssadd (entlast) ss2)
								(setvar "osmode" old_osmd)
								(if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) 
										(progn
												(sssetfirst nil ss2)
												(princ "\n pour choix; < Entrée > /[Espace]/Click+droit pour finir!.")
												(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
														(cond
																((eq (car key) 5)
																		(if (< (distance pc1 (cadr key)) (distance pc2 (cadr key)))
																				(sssetfirst nil ss1)
																				(sssetfirst nil ss2)
																		)
																)
														)
												)
										)
								)
								(command "_.erase")
								(setvar "CMDECHO" 1)
								(princ "\n*Cercle coupé aux points obligés* by me!!\n")
						)
						(T (princ "\nDes intersections valides n'ont pu être trouvées!"))
				)
		)
		(T
				(entdel (entlast))
				(entdel e_cir)
				(princ "\nPas d'intersection!")
		)
)
(prin1)
)

[Edité le 30/5/2006 par bonuscad]

[Edité le 5/6/2006 par bonuscad]

(gile) · le 27 mai 2006

Salut,

Un problème chez moi avec une ligne ou polyligne, j'ai ce message ;

Sélectionner l'objet pour la tangence: ; erreur: type d'argument incorrect:
numberp: nil

avec un arc ou un cercle :

Sélectionner l'objet pour la tangence: ; erreur: type d'argument incorrect:
point 2D/3D: (nil nil nil)

Je n'ai pas cherché plus en profondeur, et fais ces premiers essais dans le SCG.

bonuscad · le 27 mai 2006

Merci pour le "retour".

Si je crois me souvenir tu es sous 2007.

Je l'ai conçu sous une 2005-2002. Donc il est fort possible que sous 2007 ça plante.

Les fonction vlax, si elles sont perfommante, ont l'énorme désavantage de présenter des incompatibilté entre version :mad:

Je ne puis malheuresement corrigé ce problème pour l'instant :(

(gile) · le 27 mai 2006

Salut, je ne pense pas que le problème vienne de la version, je n'ai, jusqu'à présent, remarqué aucun dysfonctionnement avec les fonctions vlax-... sur 2007.

Je pense avoir décelé une erreur pour les lignes et polylignes :

(cond

((> det_or 0.0) (setq dir (+ (angle p_10 p_11) (/ pi 2))))

((

)

si det est à 0.0 dir se retrouve à nil, je propose :

(cond

((>= det_or 0.0) (setq dir (+ (angle p_10 p_11) (/ pi 2))))

((

)

Et pour toutes les entités, c'est avec pc2 qu'il y a un problème (nil nil nil)

Je pense que c'est parceque lst_int ne contient (dans mes essais) qu'un point d'intersection.

(gile) · le 27 mai 2006

J'ai modifié le code, pour récupérer les centres sans passer par la construction d'entités invisibles, çà semble fonctionner (si c'est bien ce que tu voulais faire ;) )

Si tu veux t'en inspirer :

Code effacé au vu de la suite de la discussion

[Edité le 27/5/2006 par (gile)]

bonuscad · le 27 mai 2006

Merci gile,

j'ai essayé ta proposition, elle fonctionne que sur les arcs ou cercle, mais ne fait pas du tout ce que je veux.

Pour être clair, le but premier est de fournir un point de départ un rayon et le programme regarde si la solution est possible pour terminer l'arc tangent à l'objet sélectionné en commencant par le point et de rayyon donné..

Si cela est possible les 4 solutions sont proposé: droite - gauche, arc simple et arc complémentaire (pour les 2 cotés) L'arc simple et complémentaire font en fait le cercle entier à l'écran, il faut supprimer manuellement la solution que l'on ne veut pas retenir.

(cond
((> det_or 0.0) (setq dir (+ (angle p_10 p_11) (/ pi 2))))
((< det_or 0.0) (setq dir (- (angle p_10 p_11) (/ pi 2))))
)

Ceci me sert juste à savoir ou est le point de départ par rapport à une ligne (à droite ou à gauche) pour savoir si je dois ajouter ou retrancher PI/2. Le cas = 0 est si le point de départ est sur la ligne cas peu probable car on cherche a y être tangent.

J'espère que tu avais mal compris le but, ce qui pourrait expliquer l'echec de la routine car elle fonctionne bien chez moi, il faut dire que j'ai compris la logique de la commande puisque que je l'ai créé ;)

Essayais tu de démmarrer avec un point qui se trouvait sur l'objet de tangence?

(gile) · le 27 mai 2006

Essayais tu de démmarrer avec un point qui se trouvait sur l'objet de tangence?

Ben oui, et en plus avec accrochage PRO pour être sûr :cool:

Je viens d'essayer comme il faut, çà marche :D

Il faudrait peut-être faire un test pour les benets comme moi qui choisissent le point de départ sur l'objet de tangence :mad2:

(if (vlax-curve-getDistAtPoint (vlax-ename->vla-object (car ent)))

(progn

(prompt "\nLe point de départ est sur l'objet de tangence, GROS BENET !!!")

(exit)

)

bonuscad · le 27 mai 2006

Tu me rassures

GROS BENET !!!

Mais non !!! , ça prouve simplement que ma logique est mal transcrite et incompréhensible.

Ce qui parrait évident pour nous, ne l'ait pas forcément pour les autres.

Je paufinerais pour éviter ce cas.

Merci encore

(gile) · le 27 mai 2006

Le test que je proposais avec (vlax-curve-getDistAtPoint (vlax-ename->vla-object (car ent)) est nul, le point pourrait être sur un autre segment de la polyligne, il vaut sûrement mieux tester la valeur de dir et la longueur de lst_int les erreurs que j'ai eu.

Bonne nuit.

bonuscad · le 30 mai 2006

Suite aux remarques de gilles, j'ai modifié la routine pour éviter de pouvoir saisir le point de départ sur la tangente.

J'ai corrigé certaines abbérations de construction que j'ai remarqué et j'ai essayé surtout d'étendre la commande à des objets situé sur un SCU non parrallèle, pour peu que celui soit courant.

A priori cela fonctionne bien avec des segments droit, mais avec des arcs je me heurte toujours a une erreur renvoyé par (vlax-safearray->list (vlax-variant-value (vla-IntersectWith si mes 2 objets sont des cercles dans un scu non parrallèle.

Est ce une limitation de vla-intersectwith

exemple

 
(trans
(vlax-safearray->list
(vlax-variant-value
	(vla-IntersectWith
		(vlax-ename->vla-object (car (entsel)))
		(vlax-ename->vla-object (car (entsel)))
		1
	)
)
)
0
1
)

de 2 cercles dans un scu non parrallèle me retourne qu'UNE SEULE intersection.... :mad:

(gile) · le 4 juin 2006

Réponse un peu tardive.

Le LISP fonctionne très bien dans les SCU parallèles au SCG (en tout cas, je n'ai pas eu de problèmes). Mais il a un comportement capricieux dans les SCU non parallèles au SCG, des fois çà marche bien, des fois à moitié, des fois pas du tout.

J'ai fait quelques tests avec (vla-IntersectWith ...)

3 cercles (rouge, jaune, vert, cyan) tous dans le même plan non parallèle au SCG.

http://img185.imageshack.us/img185/4763/intersect1wy.png

avec les cercles vert et cyan (puis cyan et vert) :)

_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
cyan
vert
0
)
)
)
(2218.6 3092.01 -311.012 1790.26 2563.9 -117.803)
_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
vert
cyan
0
)
)
)
(1790.26 2563.9 -117.803 2218.6 3092.01 -311.012)

avec les cercles rouge et vert (puis vert et rouges) :casstet:

_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
rouge
vert
0
)
)
)
(2166.88 3445.7 -283.887 1386.54 3721.53 79.3553)
_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
vert
rouge
0
)
)
)
(2166.88 3445.7 -283.887)

avec les mêmes, si on change l'option d'extension :mad2:

_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
rouge
vert
3
)
)
)
(2166.88 3445.7 -283.887)
_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
vert
rouge
3
)
)
)
(2166.88 3445.7 -283.887 1386.54 3721.53 79.3553)

avec les cercles rouge et jaune (ou jaune et rouge) :(

_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
rouge
jaune
0
)
)
)
; erreur: Le serveur ActiveX a renvoyé une erreur: Index non valide
_$ (vlax-safearray->list
(vlax-variant-value
(vla-IntersectWith
jaune
rouge
0
)
)
)
; erreur: Le serveur ActiveX a renvoyé une erreur: Index non valide

PS : J'ai conservé le dessin, si çà intéresse quelqu'un ...

[Edité le 4/6/2006 par (gile)]

bonuscad · le 5 juin 2006

Merci Gilles,

Au cours de mes tests, j'ai remarqué un comportement aléatoire de (vla-IntersectWith...) avec les cercles, comme ceux que tu décris.

Du coup, j'ai encore modifié la routine pour éviter l'erreur et sortir proprement.

Je me suis servir d'un test de Bill Kramer et appliquer comme suit:

((lambda ( / i_pts)

(setq i_pts

(vlax-variant-value

(vla-intersectwith

(vlax-ename->vla-object (car (entsel)))

1

)

(if (> (vlax-safearray-get-u-bound i_pts 1) 0) ; test de Bill Kramer

(vlax-safearray->list i_pts)

(princ "\nNe peut trouver d'intersection")

)

))

Le plus étrange, est que le comportement arrive a être différent suivant l'endroit ou on sélectionne les cercles :o

Soit c'est une erreur, ou 1 seule intersection, soit les 2 !?!,

J'ai abandonné à comprendre le pourquoi du comment, la routine fonctionne bien pour des besoins simples et c'est l'essentiel.

Connexion

Tracer un ARC avec pt de départ, rayon et un objet pour la tangente

Messages recommandés

bonuscad

(gile)

bonuscad

(gile)

(gile)

bonuscad

(gile)

bonuscad

(gile)

bonuscad

(gile)

bonuscad

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante