Nettoyage de dessins : Blocs sur Polylignes

[lecrabe]

 

Hello

 

J'ai un petit probleme que je n'arrive pas à résoudre facilement meme avec les super outils de

nettoyage de dessins de MAP dont l'algorythme "Couper aux Intersections" n'a malheureusement AUCUN parametre de fonctionnement ! :o

 

C pour déplacer des blocs/symboles sur du Reseau et couper le Réseau ...

 

Je pense que cela va interesser pas mal de monde !

 

Voila ce que je désire realiser :

 

1) Soit on selectionne un seul nom de Bloc specifique,

soit tous les Blocs d'une selection AutoCAD classique ...

 

2) On selectionne les polylignes, lignes par une selection AutoCAD classique

ou bien on donne un nom de Calque specifique ...

(sous entendu on ne traite que les lignes, polylignes de CE Calque)

 

3) On donne un parametre R réel positif qui est en fait le rayon de recherche

autour du bloc/symbole (Valeur par defaut R = 1.00)

 

*** Traitement ***

 

On parcourt la liste des blocs/symboles et pour chaque bloc/symbole,

on recherche dans un rayon R, tous les reseaux possibles

et pour celui est le plus PROCHE (si N reseaux possibles)

 

On deplace "au plus court en fait" le bloc/symbole

sur la ligne ou polyligne de reseau au point XY

 

Puis on coupe la ligne ou polyligne de reseau au point XY

On obtient ainsi 2 lignes ou 2 polylignes ...

 

Et au point XY on a le point d'insertion du bloc/symbole

ET le depart ou extremite de DEUX lignes ou polylignes

 

ATTENTION: il peut y avoir des XDATAs sur la ligne ou polyligne du Reseau

et donc la commande coupure ne doit pas les perdre sur la 2eme ligne ou polyligne generee !

 

La commande COUPURE d'AutoCAD ne perd pas les XDATAs

donc en principe pas de souci ...

 

Ensuite pour avoir un resultat simple du traitement, on fait defiler sur l'ecran texte d'AutoCAD les infos suivantes sur TOUS les blocs/symboles traites (deplaces en fait)

 

Nom du bloc, X, Y, Handle du bloc, Handle ligne/polyligne 1, Handle ligne/polyligne 2

 

Ainsi par un copier/coller ulterieur vers Excel, on pourra analyser le tout ...

 

Ou sinon si cela ralentit trop le processus, on genere un fichier texte !

 

Dans l'attente de votre aide, Merci d'avance, Le Decapode

 

[bseb67]

salut lecrabe!

 

Oula, ca va faire chauffer les méninges ton truc ;) .

 

L'utilité directement je n'en ai pas, mais qui sait....

 

Ensuite pour avoir un resultat simple du traitement, on fait defiler sur l'ecran texte d'AutoCAD les infos suivantes sur TOUS les blocs/symboles traites (deplaces en fait)

 

Nom du bloc, X, Y, Handle du bloc, Handle ligne/polyligne 1, Handle ligne/polyligne 2

 

Ainsi par un copier/coller ulterieur vers Excel, on pourra analyser le tout ...

 

Ou sinon si cela ralentit trop le processus, on genere un fichier texte !

 

Faire des print régulièrement te fait perdre du temps, et tu en perds encore plus avec de (print ... file) ou write-line. Les accès disque sont très lents.

 

Je pencherai sur un stockage dans une liste, une petite dcl pour afficher à la fin avec l'option envoyer dans le copier coller (ou générer le fichier en un bloc)

[(gile)]

Salut,

 

Quelque chose comme ça ?

Je ne me suis pas occupé des problèmes de SCU différents du SCG ni des calques verrouillés.

 

(defun c:LeCrabe (/ *error* CutAtBlk SelByCircle blss plss lay rad col plst cut rslt ss nlst)

 (vl-load-com)

 ;;========================================;;

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
   )
   (setvar 'cmdecho ech)
   (setvar 'osmode osm)
   (vla-EndUndoMark (vla-get-Activedocument (vlax-get-acad-object)))
   (princ)
 )

 ;;========================================;;

 (defun CutAtBlk (blk rad lst col / ec sel)
   (setq ins (cdr (assoc 10 (entget blk))))
   (if	(and
  (setq	sel (SelByCircle
	      (trans ins 0 1)
	      rad
	      '((0 . "LINE,LWPOLYLINE"))
	    )
  )
  (setq	sel (vl-remove-if
	      '(lambda (x) (or (listp x) (null (member x lst))))
	      (mapcar 'cadr (ssnamex sel))
	    )
  )
)
     (progn
(setq sel (vl-sort
	    (mapcar
	      '(lambda (x)
		 (cons x (vlax-curve-GetClosestPointTo x ins))
	       )
	      sel
	    )
	    '(lambda (x1 x2) (		  )
)
  (vl-cmdf "_.break" (caar sel) (cdar sel) "@")
(and
  (not (equal ins (cdar sel) 1e-9))
  (vl-cmdf "_.move" blk "" ins (cdar sel))
  (= col "Oui")
  (vl-cmdf "_.chprop" blk "" "_color" 1 "")
)
(list blk (entlast))
     )
   )
 )

 ;;========================================;;

 (defun SelByCircle (cen rad fltr / ang pts)
   (setq ang 0.0)
   (repeat 100
     (setq pts (cons (polar cen (setq ang (+ ang (/ pi 50))) rad) pts))
   )
   (ssget "_CP" pts fltr)
 )

 ;;========================================;;

 (setq	ech (getvar 'cmdecho)
osm (getvar 'osmode)
 )
 (if (or
(and
  (/= "" (setq blss (getstring T "\nNom du bloc ou : ")))
  (setq blss (ssget "_X" (list '(0 . "INSERT") (cons 2 blss))))
)
(and
  (princ "\nSélectionnez les blocs à traiter.")
  (setq blss (ssget '((0 . "INSERT"))))
)
     )
   (if	(or
  (and
    (princ
      "\Sélectionnez les ligne et polyligne ou ."
    )
    (setq plss (ssget '((0 . "LINE,LWPOLYLINE"))))
  )
  (and
    (setq lay (car (entsel "\nSélectionnez un objet sur le calque: ")))
    (setq plss
	   (ssget "_X" (list '(0 . "LINE,LWPOLYLINE") (assoc 8 (entget lay))))
    )
  )
)
     (progn
(vla-StartUndoMark (vla-get-Activedocument (vlax-get-acad-object)))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(initget 4)
(or
  (setq rad (getdist "\nRayon de recherche : "))
  (setq rad 1.0)
)
(initget "Oui Non")
(setq col (getkword "\nMettre les blocs déplacés en rouge [Oui/Non] ? : "))
(setq plst (vl-remove-if 'listp (mapcar 'cadr (ssnamex plss))))
(repeat	(setq n (sslength blss))
  (and
    (setq cut (CutAtBlk (ssname blss (setq n (1- n))) rad plst col))
    (setq plst (cons (cadr cut) plst)
	  rslt (cons (car cut) rslt)
    )
  )
)
(foreach n rslt
  (setq	elst (entget n)
	ins  (cdr (assoc 10 elst))
	nlst (vl-remove-if
	       '(lambda (x) (or (listp x) (null (member x plst))))
	       (mapcar
		 'cadr
		 (ssnamex
		   (ssget "_C" ins ins '((0 . "LINE,LWPOLYLINE")))
		 )
	       )
	     )
	
  )
  (princ
    (strcat
      "\n"
      (cdr (assoc 2 elst))
      ","
      (rtos (car ins))
      ","
      (rtos (cadr ins))
      ","
      (cdr (assoc 5 elst))
      ","
      (cdr (assoc 5 (entget (car nlst))))
      ","
      (cond
	((cadr nlst) (cdr (assoc 5 (entget (cadr nlst)))))
	(T "")
      )
    )
  )
)
(textscr)
(setvar 'cmdecho ech)
(setvar 'osmode osm)
(vla-EndUndoMark (vla-get-Activedocument (vlax-get-acad-object)))
     )
   )
 )
 (princ)
)

[lecrabe]

 

Hello Gilles

 

Je suis en train de tester avec MAP 3D 2006, cela semble bien fonctionner ! :)

 

Je reviens vers toi ultérieurement si je découvre un problème ...

 

Encore Merci et Bravo pour ta routine :) :D :cool:

 

Le Decapode "déplaceur de bloc sur son réseau"

 

[lecrabe]

 

ReHello Gilles

 

Je te sollicite "encore" pour une petite amélioration ... :)

 

Question supplémentaire : Voulez vous forcer la couleur des blocs déplacés (O/N) :

Si Oui, on forcera en Rouge (Code couleur =1) les blocs traités ...

 

Ainsi on pourra facilement se promener sur le dessin et visualiser les blocs concernés !

 

Merci d'avance et Bonne Journée, Le Decapode

 

[(gile)]

Salut,

 

J'ai modifié le code pour répondre à ta dernière demande.

[lecrabe]

 

Hello Gilles

 

Sorry mais il y a un petit problème ! :o

 

La routine fonctionne mais elle met TOUJOURS en rougle tous les blocs

- déplacés = OK

- et aussi ceux qui sont déjà bien placés sur le réseau = ANORMAL

 

Les blocs "trop loin" ne passent pas en rouge = OK

 

Quelque soit ma réponse à la question "Mise en rouge" !!!

 

Test réalisé sur MAP 3D 2006 et sur MAP 3D 2009

 

Le Decapode "remerciant"

 

 

 

[(gile)]

Désolé, je n'avais pas bien compris.

J'ain modifié le code.

[lecrabe]

 

ReHello Gilles

 

Comme d'habitude, c PARFAIT ! :) :D

 

Mille mercis, Le Decapode "Tripoteur de Blocs/Symboles sur Réseaux"