Repérer blos sur polylignes

[chris_mtp]

Bonjour à tous,

 

je dois contrôler sur une centaine de polylignes 2D environ s'il y a un bloc sur chacun des sommets de celles-ci.

Un bloc ne doit pas se trouver à moins de 0.00001 m du sommet sinon cela me plante un autre programme qui me permet d'éditer le listing des sommets de mes polylignes.

 

J'ai donc essayé de faire la liste de tous les sommets de mes polylignes puis de mes blocs puis de les comparer entre deux mais il arrive d'avoir un sommet d'une polyligne superposés avec un autre sommet d'une autre polyligne mais toujours avec le même bloc.

 

Mes blocs comportent un attrbut avec le numéro du point.

Le mieux serait de sélectionner la polyligne à contrôler puis de voir si les coordonnées des sommets correspondent aux coordonnées des blocs inséres sur ces mêmes sommets.

 

Si vous avez des idées ?

 

Merci par avance de votre aide.

John.

[Patrick_35]

Salut

 

Un lisp vite fait

(defun c:xyz(/ bl doc ent lst pt sel tbl tot tot2 trier)
 (defun trier(lst / ent tbl tot)
   (while lst
     (setq tot (length lst)
    ent (car lst)
    lst (vl-remove ent lst)
    tbl (cons (cons ent (- tot (length lst))) tbl)
     )
   )
 )

 (if (eq (getvar "cvport") 1)
   (princ "\nUniquement en espace OBJET.")
   (progn
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
     (if (ssget "x" (list (cons 0 "INSERT") (cons 66 1) (cons 410 "Model")))
(progn
  (vlax-for ent (setq sel (vla-get-activeselectionset doc))
    (setq lst (cons (list (vlax-get ent 'insertionpoint) (vla-get-textstring (car (vlax-invoke ent 'getattributes)))) lst))
  )
  (vla-delete sel)
  (setq lst (trier lst))
  (and (ssget (list (cons 0 "LWPOLYLINE,POLYLINE")))
    (progn
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(setq tot 0 tot2 0 tbl nil)
	(while (setq pt (vlax-curve-getpointatparam ent tot))
	  (setq tbl (cons pt tbl)
		tot (1+ tot)
	  )
	)
	(setq tbl (trier tbl))
	(foreach ent tbl
	  (terpri)
	  (princ (trans (car ent) 0 1))
	  (foreach bl lst
	    (and (equal (car ent) (caar bl) 1e-5)
	      (setq tot2 (+ tot2 (cdr bl)))
	      (princ (strcat " -> " (itoa (cdr ent)) " sommet(s) commun avec " (itoa (cdr bl)) " bloc(s) ayant l'attribut " (cadar bl) "."))
	    )
	  )
	)
	(princ (strcat "\n" (itoa (length tbl)) " coordonnée(s) avec " (itoa tot) " sommet(s) et " (itoa tot2) " bloc(s)."))
	(terpri)
      )
      (vla-delete sel)
    )
  )
)
(princ "\nPas de blocs avec attributs dans l'espace Objet.")
     )
   )
 )
 (princ)
)

 

@+

 

[Edité le 19/3/2009 par Patrick_35]

[chris_mtp]

Merci Patrick pour ce code qui fonctionne pas mal.

Par contre, j'ai essayé d'ajouter à la fin une ligne supplémentaire qui indiquerai le nombre de sommet de la polyligne sélectionné et le nombre de blocs trouvés de manière à faire un contrôle mais je n'arrive pas à trouver la bonne liste.

 

J'ai essayé avec

 

 

  (princ (strcat "\nNbre blocs = " (rtos tot 2 0) " Nbre sommets = " (rtos (sslength lst) 2 0))) 

mais apparemment il y a une coquille.

 

J'ai pas trop de notion en vlisp, c'est pour çà.

 

Merci en tout cas de ton aide.

John.

[Patrick_35]

Salut

 

J'ai corrigé le code pour répondre à ta demande

 

J'ai pas trop de notion en vlisp, c'est pour çà.

Ca va venir, ça va venir ;)

 

de la polyligne sélectionné

Ou des, j'avais une erreur dans le lisp, le vla-delete mal plaçé

 

@+

[chris_mtp]

Ce lisp va m'être très utile.

Par contre, j'au détecté une anomamie.

Si la polyligne est fermé, le code compte un sommet de plus alors qu'il n'y a que 4 blocs sur la même polyligne.

 

Ne pourrait on pas ajuster le code pour les polilygnes fermées (avec un code dxf 8 ou 70) je crois mais en vlisp, comment paramétrer cela ?

 

Merci en tout cas.

John.

[Patrick_35]

J'ai modifié le code pour comparer les coordonnées avec le nombre de sommets.

 

Pour tester si la poly est fermé

(if (eq (vla-get-closed ent) :vlax-true)
 ....
)

 

Je te laisse un peu chercher ;)

 

ps : lst est la liste qui contient les coordonnées des blocs. tbl la liste des coodonnées de la poly.

 

@+

[chris_mtp]

Je vais voir ce que je peux faire et je reviens vers toi si j'ai du mal.

Merci encore.

John

[chris_mtp]

Le vlisp c'est chaud.

 

J'ai essayé avec

 (if (eq (vla-get-closed ent) :vlax-true)

(vl-remove car lst)

)

insérer après le setq lst (trier lst)

 

mais j'ai le retour VLA-OBJECT nil et la .....

 

 

[Bred]

Salut,

Vérifie tes parenthèses...

(setq lst (vl-remove (car lst) lst))

 

mais pour faire ça , tu as aussi :

(setq lst (cdr lst))

 

 

[Patrick_35]

Il faut remplacer

 

	(setq tbl (trier tbl))

par

	(if (eq (vla-get-closed ent) :vlax-true)
	  (setq tbl (trier (cdr tbl))
		tot (1- tot)
	  )
	  (setq tbl (trier tbl))
	)

 

Pour une poly fermée, la première et dernière coordonnées sont identiques. Donc un (cdr tbl) m'élimine la dernière.

 

Un (cdr '(1 2 3 4)) retourne '(2 3 4).

 

Comme la liste est constituée avec des cons, la liste des coordonnées enregistrée dans la variable tbl est inversée par rapport aux coordonnées réel de la poly.

Ce qui fait que si j'élimine la première, en réalité je supprime la dernière coordonnée.

De plus, le total des sommets est lui aussi à revoir, je le décrémente donc de 1

 

En espérant être clair

 

@+

 

[chris_mtp]

C'est plus subtil que ce que je pensais.

Merci pour ton aide.

 

John.