Compare 2 plans

vinz34 · le 17 avril 2008

Bonjour,

A force de recevoir des mises à jour plans avec une seule modification annoncée alors que d'autres ne le sont pas (oubli volontaire ou non), je me suis penché sur la réalisation d'une routine qui permet de comparer 2 plans.

Son fonctionnement est simple, le nouveau plan doit être ouvert, le lisp chargé lancer la commande cdwg. D'abord vous êtes invité à sélectionner l'ancien plan de réference puis il crée un plan sur lequel ressortent les modifications, ajouts ou suppressions.

Le code est encore brut de décoffrage et le temps d'exécution parfois long sur un gros plan (env. 7mn pour 50000 entités).

;;;*****************************************************************************
;;;*****************************************************************************
;;;************ 	   ** COMPARE 2 PLANS **		****************
;;;*****************************************************************************
;;;******	*** créé le 16/04/08 par Vincent Dufournaud *** 	  ******
;;;*****************************************************************************
;;;*****************************************************************************


(vl-load-com)

(defun c:cdwg (/       app     cdoc    fichier old     name    sp1
       sp2     lst2    e       obj     lstmodif	       lstajout
       lstsuppr	       lst     obj     sup
      )

(setq ACADLSPASDOC (getvar "ACADLSPASDOC"))
(setvar "ACADLSPASDOC" 0)

 (setq	app	(vlax-get-acad-object)
cdoc	(vla-get-activedocument app)
fichier	(getfiled
	  "Sélection de l'ancien plan"
	  (strcat (vl-filename-directory (vla-get-fullname cdoc))
		  "/"
	  )
	  "dwg"
	  4
	)
old	(vla-open (vla-get-documents app) fichier)
name	(vla-get-fullname cdoc)
s	(getvar "date")
t1	(* 86400.0 (- s (fix s)))
 )

 (vla-saveas
   cdoc
   (strcat (substr name 1 (- (strlen name) 4))
    " Modications depuis "
    (vla-get-name old)
   )
 )

 (setq	sp1 (vla-get-modelspace cdoc)
sp2 (vla-get-modelspace old)
 )

 (vlax-for lay	(setq layers (vla-get-layers cdoc))
   (vlax-put lay 'color 253)
   (vla-put-lock lay :vlax-false)
 )

 (vlax-for lay	(vla-get-layers old)
   (vla-put-lock lay :vlax-false)
 )

 (vlax-for ent	sp2
   (setq lst2 (cons (cons (vla-get-handle ent) ent) lst2))
 )

 (defun equal-objects (obj1 obj2)
   (vl-every
     (function
(lambda	(p)
  (or (not (vlax-property-available-p obj1 p))
      (equal (vlax-get obj1 p)
	     (vlax-get obj2 p)
	     1e-9
      )
  )
)
     )
     '(ObjectName    Center	    Radius	  Coordinates
StartPoint    EndPoint	    StartAngle	  EndAngle
MajorAxis     RadiusRatio   TextString	  InsertionPoint
Width	      Height
      )
   )
 )

 (vlax-put (vla-add layers "0.Ajouts") 'color 172)
 (vlax-put (vla-add layers "0.Modications") 'color 10)
 (vlax-put (vla-add layers "0.Suppressions") 'color 92)

 (vlax-for ent	sp1
   (vla-put-color ent 256)

   (if	(setq e (assoc (vlax-get ent 'handle) lst2))
     ;;vérifie si le handle existe sur les 2 plans
     (progn
(cond ((not (equal-objects ent (cdr e)))
       (vla-put-layer ent "0.Modications")
      )
)
(setq lst2 (vl-remove e lst2))
     )
     (vla-put-layer ent "0.Ajouts")
   )
 )

 (if lst2
   (foreach n lst2
     (vla-put-layer
(car (vlax-invoke old 'CopyObjects (list (cdr n)) sp1))
"0.Suppressions"
     )
   )
 )

 (vla-close old)
 (vla-purgeall cdoc)
 (vla-save cdoc)
 (setq	s  (getvar "date")
t2 (* 86400.0 (- s (fix s)))
tt (- t2 t1)
 )

 (if (> tt 60)
   (progn
     (setq sec	(rem tt 60)
    mn	(strcat (rtos (/ (- tt sec) 60) 2 0) " mn ")
    sec	(strcat (rtos sec 2 0) " s")
     )
   )
   (progn
     (setq sec	(strcat (rtos tt 2 0) " s")
    mn	"0 mn "
     )
   )
 )

 (alert
   (strcat
     "Plan de repérages des modifications\n\nLes ajouts sont en vert\nLes modifications en rouge\nLes suppressions en bleu\n\nTemps d'éxecution : "
     mn
     sec
   )
 )
(setvar "ACADLSPASDOC" ACADLSPASDOC)
)					;defun

[Edité le 17/4/2008 par vinz34]

[Edité le 29/4/2008 par vinz34]

didier · le 17 avril 2008

hello,

cool,

ça fait un bail que je voulais m'y mettre

et tu l'as fait

grand merci.

vinz34 · le 17 avril 2008

Salut,

Maintenant j'espère que tout le monde ne va se contenter de simplement prendre le code.

J'attends des retours et des remarques pour l'améliorer.

didier · le 17 avril 2008

coucou

c'est pas le genre de la maison ...

de mon côté j'avais pensé à créer un nouveau fichier avec les seules modifications.

je pense m'y mettre un de ces jours,

je diffuserai le code.

amicalement

vinz34 · le 17 avril 2008

Re,

Quand tu dis :

j'avais pensé à créer un nouveau fichier avec les seules modifications

Tu ne veux pas visualiser les objets supprimés si je comprends bien.

Je pense qu'il est quand même parfois utile de les voir (éventuellement ça peut être une option au lancement de la routine).

mdsv31 · le 17 avril 2008

Je les révais et vinz34 la réalisée.

Je ne sais plus quoi dire.

Je les testais sur des p'tits fichiers (pavillons de 150m²) et pas de souccis. Des que j'attaque un gros chantier je te ferais par des remarques sur se type de fichiers.

Encore merci pour se super code.

@+

MDSV31

autospeed · le 18 avril 2008

J'ai testé ton lisp sur des plans archis bien lourds et il fonctionne bien , on dirtait qu'il y a une petite inversion a faire dans les couleurs entre les objets supprimés et ceux rajoutés. La méthode que j'employais jusqu'ici etait la suivante.

coloration du nouveau plan en vert

coloration de l'ancien plan en bleu

superposition des deux plans par l'appel d'un des plans en Xref

tirage couleur avec activation de la fusion des lignes.

Phil http://www.kheops.biz

lesourd2 · le 18 avril 2008

Salut vincent

Je tenais moi aussi à te remercier pour ce code. Tout simplement genial.

on dirtait qu'il y a une petite inversion a faire dans les couleurs entre les objets supprimés et ceux rajoutés

.

Moi aussi au debut j'ai un peu tiquer mais,je pense qu'il faut de le prendre dans le sens ancien plan vers le nouveau plan.

@+

autospeed · le 18 avril 2008

Il suffit d'inverser vert et bleu dans les dernieres lignes de codes et le tour est joué.

Phil http://www.autospeed.biz

lili2006 · le 18 avril 2008

Bonjour à toutes et tous,

Ca ne semble pas fonctionner avec les blocs chez moi ??

Mais, c'est peut-être normal,...

Beau travail vinz34en tous cas,..

J'ai également de temps à autre ce message =>

Commande: cdwg
Mise à jour des index pour le bloc *Model_Space
Terminé.
; erreur: Une exception s'est produite
Commande:

Ou bien =>

Commande: cdwg
Mise à jour des index pour le bloc *Model_Space
Terminé.
; erreur: Une exception s'est produite
Commande:
Commande: Mise Commande inconnue "MISE". Appuyez sur F1 pour obtenir de l'aide.
Commande: à AJUSTER
Paramètres courants: Projection=SCU, Côté=Aucun
Sélectionnez les arêtes sécantes...
Sélectionnez les objets ou : jour
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : des
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : index
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : pour
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : le
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : bloc
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : *Model_Space
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : Terminé.
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : ;
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : erreur:
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : Une
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : exception
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : s'est
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : produite
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : Commande:
*Sélection non valable*
Attend un point ou
Fenêtre/Dernier/Capture/BOîte/TOUT/Trajet/SPolygone/CPolygone/Groupe/Ajouter/Sup
primer/Multiple/Précédent/annUler/AUto/uniQue
Sélectionnez les objets ou : *Annuler*
*Incorrect*
Commande: '_.zoom _e

[Edité le 18/4/2008 par lili2006]

Je n'arrive pas non plus à récuperer les infos de suppressions à priori,...

[Edité le 18/4/2008 par lili2006]

(gile) · le 18 avril 2008

Salut,

Joli code, vinz34 ;)

Ca ne semble pas fonctionner avec les blocs chez moi ??

Je pense que, pour les blocs, iil faudrait ajouter à la liste des propriétés de la routine "equal-objects" les propriétés :

Rotation

XScaleFactor

YScaleFacor

ZScaleFactor

À ce propos, on peut supprimer ObjectName de cette liste puisque le handle est vérifié.

Et il est probable que pour diminuer le temps d'exécution, il serait préférable de ne tester que certaines propriétés suivant le type d'entité (même si ça rallongerait assez considérablement le code).

x_all · le 18 avril 2008

je me joint a la liesse populaire et adresse mes félicitation à vinz34...

entre purge archicad et ce lisp, je gagne un temps fou car je bosse avec des archi un peu autiste qui balancent leur plans sans me dire quelles sont les modifs

jouer au jeux des 7 erreurs peut etre amusant, mais quand c sur un A0 ++ et qu'on ne sais pas combien il y a d'erreurs à trouver c vite lassant...

merci beaucoup

vinz34 · le 21 avril 2008

Salut,

Autospeed, le coup des couleurs est un classique, ça me rappelle celui des fenêtres. J en'y attache que peu d'importance, le fait de n'avoir que 3 calques permet de le gérer simplement.

Lili, je n'ai pas approfondi sur les blocs, je vais l'intégrer (vérifier dans la table). Quand aux erreurs, je ne vois pas je test encore...

(gile), merci pour ton aide. Je rajouterai les props pour les blocs. Je tiens à vérifier le 'ObjectName, j'ai rencontré un cas ou le handle était identique mais pas le type d'entité. J'avais commencé par des tests par type d'entité et la différence niveau temps n'est pas perceptible.

(gile) · le 21 avril 2008

Salut,

Pour les blocs, il serait peut-être intéressant de noter aussi les modifications d'attributs.

Je te propose une nouvelle version de "equal-objects" qui semble fonctionner (pas testée en profondeur.

;; EQUAL-OBJECTS (gile)
;; Compare les propriétés de deux objets

(defun equal-objects (obj1 obj2)
 (vl-every
   (function
     (lambda (p)
(and
  (or
    (not (vlax-property-available-p obj1 p))
    (equal (vlax-get obj1 p)
	   (vlax-get obj2 p)
	   1e-9
    )
  )
  (or
    (not
      (and (= (vla-get-ObjectName obj1) "AcDbBlockReference")
	   (= (vla-get-HasAttributes obj1))
      )
    )
    (vl-every 'equal-objects
	      (vlax-invoke obj1 'getAttributes)
	      (vlax-invoke obj2 'getAttributes)
    )
  )
)
     )
   )
   '(ObjectName     Center	    Radius	   Coordinates
     StartPoint     EndPoint	    StartAngle	   EndAngle
     MajorAxis	     RadiusRatio    TextString	   InsertionPoint
     Width	     Height	    Rotation	   XScaleFactor
     YScaleFacor    ZScaleFactor
    )
 )
)

PS pour les erreurs de lili2006, je ne pense pas que ça vienne directement de ce LISP (Commande: Mise Commande inconnue "MISE". Appuyez sur F1 pour obtenir de l'aide.)

vinz34 · le 21 avril 2008

OK, je l'intègre avec des tests supplémentaires pour les blocs (recherche dans la table. Je sais le faire avec le code dxf, mais je vais le faire en vl (j'apprends).

Merci.

(gile) · le 21 avril 2008

Salut,

Pour récupérer la collection de blocs du dessin:

(setq blocs (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))

Pour récupérer une liste de tous les noms de blocs du dessin:

(vlax-for bloc blocs-coll

(if (not (wcmatch (setq nom (vla-get-Name bloc)) "`**_Space*"))

(setq bloc-list (cons nom bloc-list))

)

Pour savoir si un bloc appartient à la collection:

(not (vl-catch-all-error-p

(vl-catch-all-apply

'vla-item

(list (blocs-coll nom_du_bloc))

)

vinz34 · le 23 avril 2008

Salut,

Merci (gile), dès que je trouve un moment je l'achève (j'ai commencé à comparer les blocs concernés dans les table des fichiers).

denis38 · le 24 avril 2008

Salut a tous

C'est trop de la balle :exclam:

pour mon premier essais ça marche nickel

merci vinz34 je prend note ci j'ai des prob avec

@+

Denis

tyrese69_ · le 29 avril 2008

Bonjour Vinz34,

Ceci n'est qu'une remarque avec un cas de figure particulier !

Dans nos routines lisp, nous utilisons la variable ACADLSPASDOC avec la valeur "1"

pour que la routine AutoCAD.lsp soient chargée avec tous les dessin

et AutoCAD.lsp ele même utilise:

(defun S::STARTUP()

qui lance:

(vl-vbarun "ACADStartup")

ce qui permet d'avoir l'équivalent lisp pour le VBA,

dans ce cas pour que ta routine focntionne, il faut au préalable la remettre provisoirement à 0

(setq varacad (getvar "ACADLSPASDOC"))

(setvar "ACADLSPASDOC" 0)

puis la restituer !

à la fin

(setvar "ACADLSPASDOC" varacad)

Car sans celà la routine reste arrêter avec sur la ligne de commande " nom de la macro:"

Bravo pour ce lisp qui sera util à bien des personnes !

daniel OLIVES

vinz34 · le 29 avril 2008

Salut,

J'intègre la variable "ACADLSPASDOC".

Je travaille encore sur les blocs (je n'ai pas beaucoup de temps en ce moment).

vinz34 · le 2 mai 2008

Salut,

Quelques modifications por une version 2.0 :

- vérification des attributs (merci (gile))

- utilisation de l'Objectdbx (merci Patrick_35)

;;; par vinz34
;;;créé le 16.04.2008
;;;modifié le 02.05.2008 : (compare les attributs et analyse par Object.dbx

VOIR PLUS BAS POUR LES DERNIERS CORRECTIFS

Je test encore les blocs..

Bon week-end.

Edit : ajout d'un test conseillé par (gile) au choix de l'ancien plan.[Edité le 3/5/2008 par vinz34]

[Edité le 6/5/2008 par vinz34]

(gile) · le 2 mai 2008

Salut,

Super :D

Juste une petite remarque, il n'y a pas de contrôle au cas où l'utilisateur ferait "Annuler" dans la boite de dialogue getfiled.

Après le setq, faire un (if fichier (progn ...)) permettrait d'éviter une erreur dans ce cas.

vinz34 · le 3 mai 2008

Salut,

Merci (gile), je n'avais pas pensé à ce test.

J'ai mis une boucle à la place du if.

lili2006 · le 5 mai 2008

Bonsoir à toutes et tous,

vinz34, à ce stade d'avancement, fonctionne très bien sur une V2008.

Cet outil va en dépanner plus d'un, c'est sûr,...

vinz34 · le 6 mai 2008

Salut,

Merci lili2006, j'ai fais plus de test avec la dernière version et j'avoue qu'elle n'est pas encore tout à fait au point, j'ai quelques anomalies à régler encore avant de tester dans les blocs.

Compare 2 plans

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante