Icrémentation Texte dans l\'ordre d\'une Polyligne

[jarod34]

Bonjour,

 

Voici un lisp monté rapidement pour insérer un texte sur chaque point ce trouvant dans un calque de manière incrémenté dans le sens de ma polyligne (axe projet).

Comme c'est un axe long (27km) et qu'il est géo référencé et part dans tout les sens, je ne peux pas me servir des commandes Autocad pour incrémenter mes textes, même celles du menus Express! D'ou ce petit lisp qui fonctionne que sur de petit axe!!!

Quelqu'un pourrait-il m'aider pour faire en sorte qu'il traite les axes beaucoup plus long?

Jusqu'à 400m pas de souci ...

 

(defun c:G18a()

(vl-load-com)

(princ "\nAttention au sens de la polyligne d'AXE!!!")

(setq cc (getvar "clayer"))

(setq r (strcase (getstring (strcat "\nCalque d'insertion de la numérotation: <" cc "> : "))))

(if (= "" r)(setq r cc))

(setvar "clayer" r)

(setq num (getreal "\nNuméro de départ <1>: "))

(if (= nil num)(setq num 1))

(setq haut (getreal "\nHauteur du texte <1>: "))

(if (= nil haut)(setq haut 1))

(setq ObjLwHaut (car (entsel "\nSélectionner l'AXE : ")))

(setq VlaObjLwHaut (vlax-ename->vla-object ObjLwHaut))

(SommetLWPol (entget ObjLwHaut))

(setq LstPointsLwHaut LstPointsLw)

(setq NbreSommet (length LstPointsLwHaut))

(setq lst (ssget "_f" LstPointsLwHaut (list (cons 0 "point"))))

(setq nombreau (sslength lst))

(setq indiceau 0)

(repeat nombreau

(setq ent (ssname lst indiceau))

(setq x (list lst indiceau))

(setq tl (vlax-get (vlax-ename->vla-object ent) 'coordinates))

(setq resul (+ num indiceau))

(command "_text" tl haut 0 (rtos resul 2 0))

(setq indiceau (1+ indiceau))

)

)

 

 

Merci!

PY

[Patrick_35]

Salut

 

(defun c:G18a(/ cc haut num pt r)
 (princ "\nAttention au sens de la polyligne d'AXE!!!")
 (while (not r)
   (setq r (getstring T (strcat "\nCalque d'insertion de la numérotation: <" (setq cc (getvar "clayer")) "> : ")))
   (cond
     ((eq r "")
(setq r cc)
     )
     ((not (tblsearch "layer" r))
(princ (strcat "\nCalque " r " inexistant."))
(setq r nil)
     )
   )
 )
 (or (setq num (getint "\nNuméro de départ <1>: "))
   (setq num 1)
 )
 (or (setq haut (getreal "\nHauteur du texte <1>: "))
   (setq haut 1)
 )
 (and	(setq ObjLwHaut (entsel "\nSélectionner l'AXE : "))
(setq ObjLwHaut (entget (car ObjLwHaut)))
(eq (cdr (assoc 0 ObjLwHaut)) "LWPOLYLINE")
   (progn
     (foreach pt (vl-remove-if-not '(lambda(x)(eq (car x) 10)) ObjLwHaut)
(entmake (list	(cons   0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons   1 (rtos num 2 0))
		(cons  10 (trans (cdr pt) 1 0))
		(cons  11 (trans (cdr pt) 1 0))
		(cons   8 r)
		(cons  40 haut)
	 )
)
(setq num (1+ num))
     )
   )
 )
 (princ)
)

 

@+

[jarod34]

Merci beaucoup!

Surtout pour la manière de programmer c'est beaucoup plus léger, je vais essayer d'en prendre de la graine.

 

Seul souci, ça place un texte sur chaque sommet de la polyligne et non pas sur les points qui ce trouve sur le trajet de la polyligne ...

Je me penche dessus!

 

Un grand merci à toi

[Patrick_35]

Merci beaucoup!

De rien, de rien

 

Surtout pour la manière de programmer c'est beaucoup plus léger

C'était le but :D

 

Seul souci, ça place un texte sur chaque sommet de la polyligne et non pas sur les points qui ce trouve sur le trajet de la polyligne ...

Je me penche dessus!

Le plus dur est déjà fait ;)

 

@+

[jarod34]

En effet, mais un peu déroutant quant-on a pas l'habitude!

 

Comment pourrai-je intégrer ma sélection des points un peu partout sur ma polyligne (pas forcement sur les sommets) dans ton lisp?

 

J'était parti sur la forme avec "LstPointsLw" les coordonnées des sommets de la polyligne.

 

(setq lst (ssget "_f" LstPointsLw (list (cons 0 "point"))))

 

de façon à récupérer une sélection de tout mes points dans le bon ordre (ce qui est très important pour moi) et ensuite je pourrais utiliser

 

(entmake (list (cons 0 "TEXT")

(cons 100 "AcDbEntity")

(cons 100 "AcDbText")

(cons 1 (rtos num 2 0))

(cons 10 (trans (cdr pt) 1 0))

(cons 11 (trans (cdr pt) 1 0))

(cons 8 r)

(cons 40 haut)

)

 

Sur ma liste de point "lst".

 

Qu'en penses-tu?

 

 

[jarod34]

Mon principal problème vient de là:

 

(setq lst1 (ssget "_F" LstPointsLwHaut (list (cons 0 "point"))))

 

J'ai bien une liste de point dans "LstPointsLwHaut" mais il n'arrive pas à me faire la sélection avec "ssget" des points. Quelle est l'erreur?? ;)

[Patrick_35]

Salut

 

Je ne pensais pas qu'il y avait des points sur les poly

Le lisp modifié en conséquence

 

(defun c:G18a(/ ang cc doc esp haut js lig lst num pt1 pt2 r sel tab)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (if (zerop (getvar "tilemode"))
   (setq esp (vla-get-paperspace doc))
   (setq esp (vla-get-modelspace doc))
 )
 (or patrick_g18a_calque (setq patrick_g18a_calque (getvar "clayer")))
 (or patrick_g18a_haut (setq patrick_g18a_haut 1))
 (or patrick_g18a_num (setq patrick_g18a_num 1))
 (princ "\nAttention au sens de la polyligne d'AXE!!!")
 (while (not r)
   (setq r (getstring T (strcat "\nCalque d'insertion de la numérotation: <" patrick_g18a_calque "> : ")))
   (cond
     ((eq r "")
(setq r patrick_g18a_calque)
     )
     ((not (tblsearch "layer" r))
(princ (strcat "\nCalque " r " inexistant."))
(setq r nil)
     )
     (T
(setq patrick_g18a_calque r)
     )
   )
 )
 (and (setq num (getint (strcat "\nNuméro de départ <" (itoa patrick_g18a_num) ">: ")))
   (setq patrick_g18a_num num)
 )
 (and (setq haut (getreal (strcat "\nHauteur du texte <" (rtos patrick_g18a_haut) ">: ")))
   (setq patrick_g18a_haut haut)
 )
 (and	(setq ObjLwHaut (entsel "\nSélectionner l'AXE : "))
(setq ObjLwHaut (entget (car ObjLwHaut)))
(eq (cdr (assoc 0 ObjLwHaut)) "LWPOLYLINE")
   (progn
     (vla-startundomark doc)
     (setq lst (vl-remove-if-not '(lambda(x)(eq (car x) 10)) ObjLwHaut)
    js (ssget "_x" '((0 . "POINT")))
    sel (vla-get-activeselectionset doc)
     )
     (while (and js (cadr lst))
(setq tab nil
      pt1 (cdar lst)
      pt2 (cdadr lst)
      ang (angle pt1 pt2)
)
(setq lig (vla-addline esp (vlax-3d-point (trans pt1 1 0)) (vlax-3d-point (trans pt2 1 0))))
(vlax-for pt sel
  (if (vlax-invoke lig 'intersectwith pt acextendnone)
    (if (and (equal (vlax-get pt 'coordinates) (vlax-get lig 'endpoint)))
      (or (caddr lst)
	(setq tab (cons (vlax-get pt 'coordinates) tab))
      )
      (setq tab (cons (vlax-get pt 'coordinates) tab))
    )
  )
)
(vla-delete lig)
(and tab
  (cond
    ((and (>= ang 0)
	  (< ang (/ pi 2))
      )
      (setq tab (vl-sort tab '(lambda(a b)(if (eq (car a) (car b))
					    (< (cadr a) (cadr b))
					    (< (car a) (car b))
					  )
			     )
		)
      )
    )
    ((and (>= ang (/ pi 2))
	  (< ang pi)
      )
      (setq tab (vl-sort tab '(lambda(a b)(if (eq (car a) (car b))
					    (< (cadr a) (cadr b))
					    (> (car a) (car b))
					  )
			     )
		)
      )
    )
    ((and (>= ang pi)
	  (< ang (+ pi (/ pi 2)))
      )
      (setq tab (vl-sort tab '(lambda(a b)(if (eq (car a) (car b))
					    (> (cadr a) (cadr b))
					    (> (car a) (car b))
					  )
			     )
		)
      )
    )
    (T
      (setq tab (vl-sort tab '(lambda(a b)(if (eq (car a) (car b))
					    (> (cadr a) (cadr b))
					    (< (car a) (car b))
					  )
			     )
		)
      )
    )
  )
  (foreach pt tab
    (entmake (list (cons   0 "TEXT")
		   (cons 100 "AcDbEntity")
		   (cons 100 "AcDbText")
		   (cons   1 (rtos patrick_g18a_num 2 0))
		   (cons  10 (trans pt 1 0))
		   (cons  11 (trans pt 1 0))
		   (cons   8 patrick_g18a_calque)
		   (cons  40 patrick_g18a_haut)
	     )
    )
    (setq patrick_g18a_num (1+ patrick_g18a_num))
  )
)
(setq lst (cdr lst))
     )
     (vla-delete sel)
     (vla-endundomark doc)
   )
 )
 (princ)
)

 

ps : j'ai évité d'utiliser le (ssget "_F" ...) car la précision n'est pas au rendez-vous et si tu zoom sur une partie de la poly, c'est uniquement ce qui est visible qui est sélectionnés

 

@+

 

Edit : modif du lisp suite à la demande de lecrabe

Edit2 : correction d'un bug

 

[Edité le 20/12/2010 par Patrick_35]

[lili2006]

Bonjour à toutes et tous,

 

Super ce lisp, :D

 

Merci Patrick,

[jarod34]

Merci Patrick!

 

Ça fonctionne sur mes premiers essais, j'essaye de regarder ça de plus près dès que je peux ;)

 

Un grand merci!

 

@+

[lecrabe]

 

Hello

 

J'ai fais une micro-micro-Modif sur cet excellent VLisp

pour numeroter les Insertions de blocs le long de la polyligne

 

----- Traitement des BLOCs et NON PAS des POINTs -----

 

Nouvelle Ligne :

js (ssget "_x" '((0 . "INSERT")))

 

qui remplace l'ancienne ligne :

js (ssget "_x" '((0 . "POINT")))

 

SVP par contre, j'aimerais bien avoir la possibilite de selectionner N polylignes

avec une numerotation qui se fera dans l'ordre du jeu de selection (tant pis, si on utilise une fenetre) et tant mieux si on fait des clics successifs sur N polylignes !

 

En esperant cette petite amelioration,

je vous souhaite a tous un excellent Noel et une bonne annee 2011

 

Le Decapode

 

 

 

[Patrick_35]

Salut

 

SVP par contre, j'aimerais bien avoir la possibilite de selectionner N polylignes

Et avec la commande multiple ?

 

@+

[lecrabe]

 

Hello

 

Oui relativement si j'ai 1-20 polylignes a traiter !

 

Mais dans ce cas SVP je te sollicte quand meme pour la micro-modif :

- Proposer le dernier calque utilise

- Proposer la derniere hauteur utilisee

- Proposer le dernier No de Depart utilise

OU sinon la derniere valeur obtenue

Ainsi on pourrait numeroter sequentiellement tous les Points, tous les Blocs

et aussi tous les vertex pour la 1ere version de la routine

 

Encore Merci pour tes super-routines, Le Decapode

 

[Patrick_35]

Voila, c'est fait lecrabe

 

@+

[jarod34]

Petite remarque!

Lorsqu'un point se situe sur un sommet de la polyligne, deux texte incrémenté sont placé au même endroit ...

 

:D

[pierrevigneux]

Bonsoir Patrick_35

 

 

Je ne sais pas si c'est à cause de ma version Autocad 2004, mais je ne vois pas la numérotation sur mon dessin.

 

Pourrais-tu me montrer un exemple ?

 

SVP.

[lecrabe]

 

Hello

 

Mon petit test du WE avec MAP 2004

et je confirme le bug evoque par Jarod34 ! :casstet:

 

Si POINT ou INSERT au sommet d'une polyligne alors DOUBLE numerotation

sur ce sommet ! Sniff !!

 

Mais j'ai confiance : Patrick_35 va nous corrigre ce micro bug !?

 

Merci d'avance, Le Decapode

 

 

 

[Patrick_35]

jarod34 & lecrabe : bug corrigé

pierrevigneux : ça fonctionne avec une v2004. Il faut que les points soient sur la poly.

 

@+

[pierrevigneux]

Bonjour Patrick_35

 

pierrevigneux : ça fonctionne avec une v2004. Il faut que les points soient sur la poly.

 

 

J'ai essayé de nouveau avec ton code corrigé, désolé mais ça ne donne aucun résultat.

 

Je ne vois aucun numéro apparaitre sur la polyligne.

Peut-être me fournir un exemple ?

 

Merci de ta patience.

@+

[lili2006]

Bonsoir à toutes et tous,

 

En effet, rien chez moi non plus,...

[Patrick_35]

Salut

 

Un exemple (hauteur texte = 10)

 

@+

[lili2006]

Bonjour à toutes et tous,

 

Chez moi =>

 

 

http://img.ahst.fr/data/images/sommetspol.jpg

 

 

(Civil 3D 2011)

 

En relançant le lisp, pas de pb !!!

 

Désolé pour le test que j'ai fait hier soir, je pensais que la poly n'avait pas forcément besoin de points,...:cool:

 

http://img.ahst.fr/data/images/sommetvwv.jpg

[Patrick_35]

Donc, c'est OK ;)

 

http://img574.imageshack.us/img574/6469/demoe.gif

 

@+

[lili2006]

Re,

 

Oui Patrick,

 

Désolé, ;)

 

PS: Bien ton animation, :P

[Patrick_35]

Merci, mais j'ai du chercher pour ne travailler qu'avec des free.

 

C'est très simple comme démarche :(

D"abord une capture vidéo en avi.

Convertion de l'avi en swf (flash) puis en Gif.

Reste plus qu'à déposer l'image chez un hébergeur.

Si tu as un free qui permet la capture vidéo directement en gif, je suis preneur.

 

@+

[lili2006]

Re,

 

En effet ! :o

 

Camstudio permet de faire du swf directement.

 

Comment fais-tu pour transformer en gif ?

 

Merci d'avance,