HELP Message d\'erreur

[drloveless]

Salut à Tous,

 

J'ai crée une appli en 2004 pour mettre automatiquement un Cartouche sur un plan et enregsitrer ce plan qq part. sur Autocad 2004, pas de probleme, mais depuis çà cagouille!! Je suis actuellement en 2009.

 

cas 1 : Je pars d'un nouveau plan, je clique sur mon petit bouton, et hop AUCUN problèmes. Depuis ce nouveau plan, je clique à nouveau sur mon p"tit bouton et hop, çà foire !!.

 

cas 2 : Je pars d'un nouveau plan, je clique sur mon petit bouton, et hop AUCUN problèmes. Je ferme Autocad, puis réouvre le dernier plan ( celui qui vient d^'étre crée) je clique à nouveau sur mon p"tit bouton AUCUN problème. Depuis ce nouveau plan, je clique à nouveau sur mon p"tit bouton et hop, çà foire !!.

 

Comprends pas pourquoi un coup çà marche, et le coup d'après çà plante !!

 

Donc en fait à chaque fois, si je pense bien à refermer Autocad avant de me reservir de cette Appli, pas de problème, mais comme à chaque fois j'oubli.... ca me saoule.

 

J'ai cherché à fond sur Internet et fait une batterie de test et de correction, mais rien n'y fait

 

.... alors A L'AIDE !!!!!!!!!!!!!!

 

Message d'erreur renvoyé: "erreur dexecution'-2145356445 (80200033) - Erreur de fichier

 

Voici la ligne qui est pointée: Set objCartouche = MECA.Block.InsertBlock(PtInsert, "C:\Cartouches\Cartouches.dwg", 1, 1, 1, 0)

 

Voici le code :

Dim objCartouche As AcadBlockReference

Dim PtInsert(0 To 2) As Double

Dim CalCou As String

Dim layerObj As Object

Dim Curlayer As Object

Dim MECA As AcadLayout

Dim MecaExist As Boolean

 

PtInsert(0) = 0: PtInsert(1) = 0: PtInsert(2) = 0

 

‘---------------------------------------------------------------------------------------------

'------ Supression des cartouches existants présent sur le document ouvert

‘---------------------------------------------------------------------------------------------

 

‘---- Supression des cartouches de MODELSPACE

For Each elem In ThisDrawing.ModelSpace

If elem.EntityType = acBlockReference Then

If elem.Name = "Cartouche" Then elem.Delete

End If

Next

 

‘---- Supression des cartouches des PAPERSPACE

For Each Present In ThisDrawing.Layouts

NomPres = Present.Name

Set MECA = ThisDrawing.Layouts(NomPres)

For Each elem In MECA.Block

If elem.EntityType = acBlockReference Then

If elem.Name = "Cartouche" Then elem.Delete

End If

Next

Next

‘---- Supression des cartouches de la bibliothèque de bloc du plan ouvert

For Each ObjBlo In ThisDrawing.Blocks

If ObjBlo.Name = "Cartouche" Then

For Each elem In ThisDrawing.Blocks.Item("Cartouche")

elem.Delete

Next elem

End If

Next ObjBlo

 

'--------------------------------------------------------

'--Test si une présentation nommée MEP1 existe déjà

'--------------------------------------------------------

 

Set Layouts = ThisDrawing.Layouts

MecaExist = False

For Each Layout In Layouts

If Layout.Name = "MEP1" Then MecaExist = True

Next

 

If MecaExist = True Then Set MECA = ThisDrawing.Layouts.Item("MECANOBLOC")

If MecaExist = False Then Set MECA = ThisDrawing.Layouts.Add("MECANOBLOC")

ThisDrawing.ActiveLayout = MECA

 

'--------------------------------------------------------

'--Insertion du cartouche nouveau cartouche sur « MEP1 »

'--------------------------------------------------------

 

Set objCartouche = MECA.Block.InsertBlock(PtInsert, "C:\Cartouches\Cartouches.dwg", 1, 1, 1, 0)

 

Set dbNumPlan = OpenDatabase("C:\BasedeDonnée\BDDNUMPLAN.mdb")

Set NumPlan = dbNumPlan.OpenRecordset("NumPlan-RD", dbOpenDynaset)

 

If Not (NumPlan.EOF And NumPlan.BOF) Then

NumPlan.MoveFirst

Do Until NumPlan.EOF

objCartouche.GetAttributes(0).TextString = NumPlan![Produit]

objCartouche.GetAttributes(1).TextString = NumPlan![NomPlan]

objCartouche.GetAttributes(2).TextString = NumPlan![NomPlan2]

objCartouche.GetAttributes(3).TextString = "0"

objCartouche.GetAttributes(58).TextString = NumeroDePlan

objCartouche.GetAttributes(59).TextString = "0"

Exit Do

 

NumPlan.MoveNext

Loop

End If

 

dbNumPlan.Close

Set dbNumPlan = Nothing

Set objCartouche = Nothing

 

Unload Me

 

ThisDrawing.SaveAs cheminplan

 

End Sub

 

[Invité Patrick]

J'ai rencontré ce bug lorsque nous sommes passés à AutoCAD 2007. Curieusement, après l'avoir signalé sur les forums Autodesk, personne n'a réagit, je n'ai toujours pas compris pourquoi j'étais le seul (nous sommes deux maintenant), à avoir rencontré ce bug... En tous cas nous avions du mettre au point une solution par programmation. Voir cet article. en français

[drloveless]

OK, effectivement nous sommes deux maintenant.

 

J'avais déjà vu ces interrogations en faisant mes recherches, et vous êtes donc le même Patrick !!

 

Etant novice en la matière, je n'ai pas compris en quoi concernant la méthode de faire deux codes en fonction de l'erreur !! Car avant je supprime les blocs de mon dessin et purge celui-ci, le fameux bloc n'existe donc plus dans la bibliothèque de bloc du dessin !!

 

Un p'tit coup de main ?

 

[Edité le 24/2/2010 par drloveless]

[Invité Patrick]

La fonction d'insertion de bloc VBA fonctionne ou pas selon que la définition du bloc est présente ou pas dans le dessin.

[drloveless]

Ha ok, ca parait tellement simple maintenant, merci beaucoup, problème réglé !!