Routine Inserer Bloc a EXTremite de PLines

[lecrabe]

Hello

 

SVP je cherche une routine que je pensais avoir mais a priori je n'ai pas en stock !

 

Soit un Bloc deja present dans le DWG (avec ou sans attribut) ou DISPO dans les chemins de support AutoCAD

 

1) On donnerait tout simplement le NOM (sur une question en ligne de commande)

2) Selection classique AutoCAD

3) Dans la selection, ne retenir que les Polylignes 2D (legeres/lourdes) et si possible aussi les 3DPolys !?

4) Inserer le Bloc concerne a CHAQUE extremite de Polylignes 2D (et 3D si possible)

5) SAUF que parfois il y a N Polylignes qui arrivent sur meme point XY (ou XYZ)

et dans ce cas bien sur, je desire n'avoir que UN SEUL Bloc ...

 

Il est sur que avec OVERKILL et/ou le nettoyage de dessins MAPCLEAN de MAP/CIVIL,

on pourrait "nettoyer" les doublons mais BON !?

 

La routine tournerait avec ATTDIA = 0

et surtout avec ATTREQ = 0 ainsi on ne sera pas "embete" par les eventuels attributs

On remet a UN les variables ATTREQ et ATTDIA apres le fonctionnement de la routine

 

Exemple classique : des canalisations "parfaites" en 2D (et/ou en 3D) et un Bloc de Tampon-Regard ...

 

A votre bon coeur, Merci d'avance, lecrabe

[x_all]

j'ai ça qui traine... c'est à adapter car il n'y a pas tout...

 

en espérant que ça dépanne...

 

(defun c:ins-vtx (/ acdoc space bl n)
 (vl-load-com)
 (setq	acdoc (vla-get-activeDocument (vlax-get-acad-object))
space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace acdoc)
	(vla-get-ModelSpace acdoc)
 		)
 )
 (if
(and
 	(setq bl (getstring T "\nEntrez le nom du bloc: "))
 	(or
(tblsearch "BLOCK" bl)
(findfile bl)
 	)
)
	(if (ssget "_X" '((0 . "*POLYLINE")))
  	(progn
    (vla-startUndoMark acdoc)
    (vlax-for pl (vla-get-ActiveSelectionSet acdoc)
      (setq n (fix (vlax-curve-getEndParam pl)))
      (or (= (vla-get-Closed pl) :vlax-false)
      	(setq n (1- n))
      )
      (repeat (1+ n)
    	(vla-InsertBlock
      	space
      	(vlax-3d-point (vlax-curve-getPointAtParam pl n))
      	bl
      	1.0
      	1.0
      	1.0
      	0.0
    	)
    	(setq n (1- n))
      )
    )
    (vla-EndUndoMark acdoc)
  	)
	)
	(princ (strcat "\nLe block \"" bl "\" est introuvable"))
 )
 (princ)
)

[Tramber]

;;; gc:remove_doubles (gile)
(defun gc:remove_doubles (lst)
 (if lst
   (cons (car lst) (gc:remove_doubles (vl-remove (car lst) lst)))
 )
)
(defun c:BEXTPL (/ acdoc space  n lipoints)
 (vl-load-com)
 (setq acdoc (vla-get-activeDocument (vlax-get-acad-object))
       space (if (= (getvar "CVPORT") 1)(vla-get-PaperSpace acdoc)(vla-get-ModelSpace acdoc))
lipoints nil
n 0 )
 (if
   (and
     (or *bl*(setq *bl* (getstring T "\nEntrez le nom du bloc: ")))
     (or(tblsearch "BLOCK" *bl*)(findfile *bl*))
     )
   (if (ssget '((0 . "*POLYLINE")))
     (progn
(vla-startUndoMark acdoc)
(vlax-for pl (vla-get-ActiveSelectionSet acdoc)
  (and (= (vla-get-Closed pl) :vlax-false)
       (setq lipoints(cons  (vlax-curve-getStartPoint pl)lipoints)
	     lipoints(cons  (vlax-curve-getEndPoint pl)lipoints))))
(setq lipoints(mapcar (function(lambda(x)(list(car x)(cadr x))))lipoints))
(setq lipoints(gc:remove_doubles lipoints))	
(foreach p  lipoints
  (vla-InsertBlock
    space
    (vlax-3d-point p)
    *bl*
    1.0
    1.0
    1.0
    0.0
    )
  (setq n (1+ n))
  )
(princ (strcat "\nLe block \"" *bl* "\" a été inséré "(itoa n)" fois"))
(vla-EndUndoMark acdoc)
)
     )
   (princ (strcat "\nLe block \"" *bl* "\" est introuvable"))
   )
 (princ)
)

 

J'ai un peu retouché tout cela. Fonctionnement de base. J'ai inclus une célèbre routine récursive.

Pourvu que tes polylignes ne soient tout de même pas trop nombreuses.... car il faudrait une autre mécanique que celle-là.

PS : une amélio consisterait à comparer les base des blocs déjà installés dans le dessin B)

[zebulon_]

Bonjour,

 

j'aimerais proposer une généralisation de la fonction remove_doubles en intégrant une possibilité d'écart maximal. Il arrive quand même assez fréquemment que deux nombres ou deux listes semblent identiques mais peuvent différer très légèrement si différentes méthodes ont été utilisées pour les calculer. L'idée est de rajouter un paramètre supplémentaire fuzz et de remplacer vl-remove par vl-remove-if dont la fonction prédicat contiendra (equal expr1 expr2 fuzz)

 

;;; gc:remove_doubles (gile)
(defun gc:remove_doubles (lst)
 (if lst
   (cons (car lst) (gc:remove_doubles (vl-remove (car lst) lst)))
 )
)


;;; cs:remove_doubles_fuzz
(defun cs:remove_doubles_fuzz (lst fuzz)
 (if lst
   (cons
     (car lst)
     (cs:remove_doubles_fuzz
       (if fuzz
         (vl-remove-if '(lambda (x) (equal x (car lst) fuzz)) lst)
         (vl-remove (car lst) lst)
       )
       fuzz
     )
   )
 )
)



(defun c:removedbl ()
 (setq l1 '(1 2 3 4 1 2 3 4 1.001 2.001 3.001 4.001))

 (print (gc:remove_doubles l1))
 (print (cs:remove_doubles_fuzz l1 0.01))
 (print (cs:remove_doubles_fuzz l1 nil))

 (setq l2 '((1 1 1) (1 1 1) (2 2 2) (2 2 2) (1.001 1.001 1.001) (2.001 2.001 2.001)))

 (print (gc:remove_doubles l2))
 (print (cs:remove_doubles_fuzz l2 0.01))
 (print (cs:remove_doubles_fuzz l2 nil))
 (princ)
)

 

Dommage qu'avec les fonctions lisp, on ne peut pas avoir de paramètre optionnel...

 

Votre avis ?

 

Amicalement

Vincent

[lecrabe]

Hello Mr Tramber et autres vaillants contributeurs

 

1) MERCI ta routine semble bien fonctionner !

 

2) A propos la routine gc:remove_doubles est "fiable" - J'ai confiance en notre admirable Gilles !

Mes modestes tests ont montre que je n'avais pas de doublon ...

mais je connais le probleme du Fuzz evoque par Zebulon_ et donc je m'inquiete simplement un "micro-poil" !?

 

Encore Merci, Bye, lecrabe

[zebulon_]

2) A propos la routine gc:remove_doubles est "fiable" - J'ai confiance en notre admirable Gilles !

 

Oui, mais tu peux faire confiance aux autres également, à commencer par toi-même.

 

Si quelqu'un propose une amélioration ou une généralisation de quelque chose qui a été inventé par quelqu'un d'autre, c'est dans un souci de progrès. Depuis Cro-Magnon, c'est quand même un état d'esprit assez fréquent.

J'attends une critique de la méthode proposée (en bien ou en mal), pas qu'on me dise "je ne regarde même pas ce que tu proposes car c'est un problème qui ne me concerne qu'à la marge". Sans vouloir te vexer, je ne te trouve pas très constructif en l'occurrence.

 

Amicalement

Vincent

[lecrabe]

Hello

 

No comprendo !

 

J ai fais des tests avec la routine de Tramber et la fonction de Gilles sur environ 20/30 Plines 2D (non testé en 3D) et TVB/RAS !

 

Donc je suis heureux et j ai remercie tout le monde...

 

MERCI, Bye, lecrabe

[Tramber]

Tant mieux, c'est un code simple qui ne cherche pas compliqué mais qui peut s'étouffer si la selection est grosse.

 

Vincent a tout de même appuyé exactement là où j'avais un petit doute.

Il semble néanmoins qu'Autolisp nous arrange bien en utilisant les valeurs renvoyées arrondies et non avec les 16 chiffres après la virgule.

Donc, gc:remove_doubles fonctionne bien mais avec le fuzz de Vincent, tu pourrais avoir une variable pour la précision des points qui seraient éventuellement très proches mais pas confondus.

On te le fait si tu veux.... B)

[zebulon_]

No comprendo !

 

Comparer des réels est toujours dangereux. Comparer des listes de réels l'est encore plus.

Je propose simplement quelque chose qui fait la même chose en plus sûr, avec l'option de ne pas s'assurer si on estime que ce n'est pas nécessaire en mettant le fuzz à nil.

 

J'étais juste un peu étonné par la formulation de ta réponse où tu en fais un peu des tonnes. Ensuite, elle laisse sous-entendre que ma solution n'est pas fiable parce qu'elle n'a pas été écrite par Gilles. Peut être as-tu raison, je n'ai fait que reprendre quelque chose d'existant en essayant d'y rajouter ce qui me semblait manquer.

 

Quand il fait nuit et que le soleil est absent, il faut être reconnaissant à la lune pour la lumière qu'elle reflète.

 

Pour terminer, je m'étonne également qu'un problème aussi simple n'est pas à la portée de quelqu'un de ton expérience. Si un petit nouveau venait déposer sa requête comme tu l'as fait, il se serait fait envoyer sur les roses vite fait avec des commentaires du genre : "commence par faire quelque chose et après on te dira ce qui va et ce qui ne va pas"

 

Amicalement

Vincent

[lecrabe]

Hello Vincent

 

J'ai ecris >>>

mais je connais le probleme du Fuzz evoque par Zebulon_ et donc je m'inquiete simplement un "micro-poil" !?

 

Malgre ce que j'ai ecris (Desole mais j'ai peut etre mal formule ma pensee !?)

Je ne suis pas programmeur/developpeur Lisp/VLisp ou tout autre langage ...

 

En fait j'ai developpe depuis 1980 jusqu'a environ l'an 2000 avec les langages suivants :

assembleur (8080, Z80, 8088, etc), basic, fortran, cobol, pascal, C+, RPG, etc

et Lisp AutoCAD R11-2000 (de 1990-2000) MAIS j'ai tout arrete depuis 15 ans et donc tout oublie ou presque ...

 

Bye, lecrabe

[zebulon_]

Hello Vincent

 

J'ai ecris >>>

mais je connais le probleme du Fuzz evoque par Zebulon_ et donc je m'inquiete simplement un "micro-poil" !?

<<<

 

Malgre ce que j'ai ecris (Desole mais j'ai peut etre mal formule ma pensee !?)

Je ne suis pas programmeur/developpeur Lisp/VLisp ou tout autre langage ...

 

En fait j'ai developpe depuis 1980 jusqu'a environ l'an 2000 avec les langages suivants :

assembleur (8080, Z80, 8088, etc), basic, fortran, cobol, pascal, C+, RPG, etc

et Lisp AutoCAD R11-2000 (de 1990-2000) MAIS j'ai tout arrete depuis 15 ans et donc tout oublie ou presque ...

 

Bye, lecrabe

 

Même parcours pour moi avec beaucoup moins de langages différents et seulement depuis 1985 pour la programmation et depuis Autocad R12 (après MicroStation) pour le dessin, MAIS j'essaye de ne pas oublier. Pour la petite histoire, mon premier ordi était un Thomson TO9...

 

Amicalement

Vincent