angle d\'1 segment de polyligne pour texte

[fabcad]

Bonjour, j'avais créé cette routine AutoLISP qui permet de rendre parallèle un textuel par rapport à un objet AutoCAD, je souhaiterais récupérer directement l'angle d'1 segment de lwpolyligne mais d'orienter en plus le texte pour que la lecture soit toujours directe (principe des cotations).

 

Merci pour l'aide,

Fabrice

 

; PARALLELE.LSP
;---------------------------------------------------------------
; MODIFIE L'ANGLE D'UN OU PLUSIEURS TEXTES
; A PARTIR D'UN OBJET.
;---------------------------------------------------------------
; Cree le 17.05.1999
;---------------------------------------------------------------
; FONCTION MAITRE
(defun c:parallele ()
(setvar "cmdecho" 0)
(setq js (sel-txts))
(if js
 (progn
    (prompt (strcat "\nNombre de textes : " (rtos (setq nbr (sslength js)) 2 0)))
    (meme-ang js)
 );fin progn
 (progn
 (prompt "\n---Pas de Textes selectionnés---")
 (princ)
 );fin progn
);fin if js
(princ)
(prompt "\n---COPYRIGHT mai 2003 par Fabrice DEMIEL---")
(prin1)
);fin c:parallele
;---------------------------------------------------------------
(defun sel-txts ()
(ssget 
'(
   (-4 . "      (-4 . "        (0 . "TEXT")

     (-4 . "AND>")
     (-4 . "        (0 . "MTEXT")

     (-4 . "AND>")
   (-4 . "OR>")
 )
);ssget
)
;-----------------------------------------------------------------
(defun meme-ang (js / c1 i ang nbr sel-obj chx2)            		
(setq cnt2 T)
(while cnt2
(initget "Global Element")
(setq chx2 (getkword "\n Quel type de travail [Global/Element]  "))	
(cond
((= chx2 "Global")
(progn
(while (= (setq sel-obj (nentsel "\n Choisir un objet de reference : ")) nil));fin select 
(setq ang (ang-obj (car sel-obj)))
(setq nbr (sslength js))
(setq i 0)
    	(while (<= i (- nbr 1))
	(setq c1 (ssname js i))
	(setq ent (entget c1))
	(setq ent (subst (cons 50 ang) (assoc 50 ent) ent))
	(entmod ent)
(setq i (+ i 1))
); fin 1er while
   );fin progn
);fin si chx2 est egal à Global
((= chx2 "Element")
   (progn
      	(setq nbr (sslength js))
      	(setq i 0)
      	(while (<= i (- nbr 1))
(setq c1 (ssname js i))	
(redraw c1 3)
(while (= (setq sel-obj (nentsel "\n Choisir un objet de reference : ")) nil));fin select er
       (setq ang (ang-obj (car sel-obj)))
       (setq ent (entget c1))
(setq ent (subst (cons 50 ang) (assoc 50 ent) ent))
(entmod ent)
(setq i (+ i 1))
       ); fin 1er while
   );fin progn
);fin si chx2 est egal à Element

(T (setq cnt2 nil))

);fin cond
);fin while cnt2
(setvar "cmdecho" 1)
)
;-----------------------------------------------------------------
(defun ang-obj (er / obj)
(setq obj (cdr (assoc 0 (entget er))))
(cond
   ((= obj "CIRCLE")
   (progn
   (princ "\nObjet Cercle definir 2 points : ")
   (setq ang (getangle "\n Définissez l'angle > Premier Point: "))
   );fin progn
   );fin CIRCLE

   ((= obj "LINE")
   (progn
   (princ "\nObjet Ligne : ")
   (setq p1 (cdr (assoc 10 (entget er))))
   (setq p2 (cdr (assoc 11 (entget er))))
   (setq ang (angle p1 p2))
   );fin progn
   );fin LINE

   ((= obj "ARC")
   (progn
   (princ "\nObjet Arc : ")
   (setq cent-arc (cdr (assoc 10 (entget er))))
   (setq ray (cdr (assoc 40 (entget er))))
   (setq ang-50 (cdr (assoc 50 (entget er))))
   (setq ang-51 (cdr (assoc 51 (entget er))))
   (setq p2 (polar cent-arc ang-50 ray))
   (setq p1 (polar cent-arc ang-51 ray))
   (setq ang (angle p1 p2))
   );fin progn
   );fin ARC
   
((= obj "MPOLYGON")
   (progn
   (princ "\nObjet MPolygone MAP 3D definir 2 points : ")
   (setq ang (getangle "\n Définissez l'angle > Premier Point: "))
   );fin progn
   );fin MPOLYGON
   
((= obj "MAPBULKFEATURE")
   (progn
   (princ "\nObjet MAPBULKFEATURE MAP 3D definir 2 points : ")
   (setq ang (getangle "\n Définissez l'angle > Premier Point: "))
   );fin progn
   );fin MAPBULKFEATURE

((= obj "LWPOLYLINE")
	(progn
	(setq param(vlax-curve-getParamAtPoint(vlax-ename->vla-object(car sel-obj))
	(vlax-curve-getclosestpointto(vlax-ename->vla-object(car sel-obj))(cadr sel-obj))))
	(setq p1 (vlax-curve-getPointAtParam(vlax-ename->vla-object(car sel-obj))(fix param)))
	(setq p2(vlax-curve-getPointAtParam(vlax-ename->vla-object(car sel-obj))(1+(fix param))))
	(setq ang (angle p1 p2))
	(princ ang)
	(if (minusp (cos ang))
		(setq ang (+ ang pi))
		(setq ang ang)
	)
	);fin progn
	);fin LWPOLYLINE

   ((= obj "INSERT")
   (progn
   (setq ang (cdr (assoc 50 (entget er))))
   );fin progn
   );fin INSERT

   ((= obj "TEXT")
   (progn
   (princ "\nObjet Texte : ")
   (setq ang (cdr (assoc 50 (entget er))))
   );fin progn
   );fin TEXT

   ((= obj "MTEXT")
   (progn
   (princ "\nObjet Mtexte : ")
   (setq ang (cdr (assoc 50 (entget er))))
   );fin progn
   );fin MTEXT

);fin cond
);fin defun ang-obj
;-----------------------------------------------------------------

[Edité le 29/1/2010 par fabcad][Edité le 31/1/2010 par fabcad]

 

[Edité le 2/2/2010 par fabcad]

[Tramber]

J'ai pas trop le temps de bien tout comprendre mais je propose ce code :

 

(setq sel-obj (nentsel "\n Choisir un objet de reference : "))
(setq param(vlax-curve-getParamAtPoint(vlax-ename->vla-object(car sel-obj))
            (vlax-curve-getclosestpointto(vlax-ename->vla-object(car sel-obj))(cadr sel-obj))))
(vlax-curve-getPointAtParam(vlax-ename->vla-object(car sel-obj))(fix param))
(vlax-curve-getPointAtParam(vlax-ename->vla-object(car sel-obj))(1+(fix param))) 

 

Ce sont les 2 points d'un côté et de l'autre de ton clic sur polyligne. Y a plus qu'à calculer l'angle !

 

Si ca peut répondre.... ?

 

NB : le vlax-curve-getclosestpointto assure de bien chercher une info sur la poly. car les vlax-curve ont besoin d'être parfaitement spécifié sur la poly.

[fabcad]

Merci Tramber,

 

Il récupère bien l'angle mais mon souci maintenant est de conserver un angle de texte idéal pour la lecture sur plan. Ceci est du au sens de la polyligne mais je peux en aucun cas le modifier car dans un SIG c'est le sens de circulation quand c'est des filaires de voies.

 

J'ai bien essayé avec ceci :

(if (> ang pi)
(setq ang (+ ang pi))
(setq ang (angle p1 p2))
);fin if

mais il ne le fait que dans un sens.

 

Preneur de vos solutions,

 

Fabrice

 

 

[(gile)]

Salut,

 

fabcad,

 

Un peu de trigo...

 

(if (minusp (cos ang))
 (setq ang (+ ang pi))
)

 

Tramber,

 

Avec les fonctions vlax-curve*, on peut récupérer l'angle de la tangente à la courbe avec vlax-curve-getFirstDeriv :

(setq ent (entsel)
     pt  (trans (osnap (cadr ent) "_nea") 1 0)
     ent (car ent)
     ang (angle '(0 0 0)
	 (vlax-curve-getFirstDeriv
	   ent
	   (vlax-curve-getParamAtPoint ent pt)
	 )
  )
)

[Tramber]

Avec les fonctions vlax-curve*, on peut récupérer l'angle de la tangente à la courbe avec vlax-curve-getFirstDeriv

 

C'est clair mais il faut se méfier des dérivés aux points (tangente avant ou après le point ?). Je ne suis pas rentré dans les détails.

[(gile)]

C'est clair mais il faut se méfier des dérivés aux points (tangente avant ou après le point ?)

 

si tu veux parler des sommets de polylignes, le problème se pose quelque soit la méthode.