Problème sur insertion de bloc

sechanbask · le 31 octobre 2007

Mon code sert à inserer des bloc pour symboliser les remonter de gaine rectangulaire... jusqu'alors j'avais pas problème. J'inserais un bloc avec une echelle comm je veux et je faisais le contre cadre après en plolyligne (je fais ça car si je fait une echelle sur un bloc qui contient déjà le contre carde, le contre cadre aura également une échelle, donc sa largeur ne sera pas fixe : 3 cm). Mais pour des problème de manipulation, je souhaiterais faire un bloc de tout gaine plus contre cadre. Pour cela, j'avais penser à me faire une bibliothèque mais c'est long et chiant sauf si c'est VBA qui me la fait tout seul :

[algorithme]

-insertion du bloc avec contre cadre largeur X longeur Y

-s'il n'existe pas ouvrir un nouveau fichier inserer le bloc sans contre cadre, exploser le bloc (pour ne pas avoir de bloc imbriqué ou avec le nom du fichier) faire le contre cadre créer le bloc Sect_rectangulaire_X_x_Y et enregistrer le fichier Sect_rect_X_x_Y.dwg et insérer le bloc...

le problème c'est que je n'arrive pas à explosé le bloc sans contre cadre...bien que j'ai déjà utilisé la même méthode ici : http://www.cadxp.com/sujetXForum-17368.htm

Sub Impact_rectangulaire()
Dim sngLargeur As Single
Dim sngLargeurmm As Single
Dim sngHauteur As Single
Dim sngHauteurmm As Single
Dim dblPoints(0 To 7) As Double
Dim objBloc As AcadBlockReference
Dim objRectangle As AcadLWPolyline
Dim objTriangle As AcadLWPolyline
Dim strUnitvar As String
Dim sngCoef As Single
Dim booSCU As Boolean
Dim dbllargech As Double
Dim dblhautech As Double
Dim dblteta As Double
Dim varOffset As Variant

'On Error GoTo Gestion

strUnitvar = ThisDrawing.GetVariable("INSUNITS")



Select Case strUnitvar

Case 4
'(millimètre)
sngCoef = 1
Case 5
'(centimètre)
sngCoef = 0.1
Case 6
'(mètre)
sngCoef = 0.001
End Select




sngLargeurmm = ThisDrawing.Utility.GetReal("Veuillez entrer la largeur de la gaine en mm : ")
sngHauteurmm = ThisDrawing.Utility.GetReal("Veuillez entrer la hauteur de la gaine en mm : ")

sngLargeur = sngLargeurmm * sngCoef
dbllargech = sngLargeur / 10
sngHauteur = sngHauteurmm * sngCoef
dblhautech = sngHauteur / 10
booSCU = False

Dim varPointinsertion As Variant
varPointinsertion = ThisDrawing.Utility.GetPoint(, "Indiquer le centre de l'impact: ")
Dim strSCU As String
On Error Resume Next
strSCU = ThisDrawing.ActiveUCS.Name
Debug.Print strSCU
Select Case Err.Number
Case "-2145386481"
booSCU = False
Debug.Print "SCG"
Case "0"
varPointinsertion = ThisDrawing.Utility.TranslateCoordinates(varPointinsertion, acWorld, acUCS, False)
booSCU = True
Case Else
Debug.Print Err.Number, Err.Description
ThisDrawing.Utility.Prompt "Une erreur inconnue est survenue, veuillez contacter le développeur."
Exit Sub
End Select
'On Error GoTo Gestion
On Error GoTo 0
'Debug.Print strSCU

dblteta = 0





On Error Resume Next
'Set objBloc = ThisDrawing.ModelSpace.InsertBlock(varPointinsertion, "Sect_rect_bloc.dwg", dbllargech#, dblhautech#, 1#, dblteta)
Set objBloc = ThisDrawing.ModelSpace.InsertBlock(varPointinsertion, "Sect_rect_" & sngLargeurmm & "x" & sngHauteurmm & ".dwg" Or "Sect_rec_" & sngHauteurmm & "x" & sngLargeurmm & ".dwg", dbllargech#, dblhautech#, 1#, dblteta)

If Err.Number <> 0 Then
On Error GoTo 0
Debug.Print Err.Number
Dim docObj As AcadDocument
Set docObj = ThisDrawing.Application.Documents.Add
Dim dblPointinsertion(0 To 2) As Double
dblPointinsertion(0) = 0#: dblPointinsertion(1) = 0#: dblPointinsertion(2) = 0#


Set objBloc = ThisDrawing.ModelSpace.InsertBlock(dblPointinsertion, "Sect_rect_bloc.dwg", dbllargech#, dblhautech#, 1#, dblteta)
'pourquoi il ne veut pas m'exploser le bloc alors qu'il est explosable?
'd'ailleur c'est bizarre quand je l'explose, les polignes qui constitue le bloc explosé sont déjà en ligne comme si je décomposé le bloc 2 fois?
'ça ne dépend pas du fichier de bloc car j'en ai essayé un autre et même chose...
objBloc.Explode


dblPoints(0) = dblPointinsertion(0) - sngLargeur / 2: dblPoints(1) = dblPointinsertion(1) + sngHauteur / 2
dblPoints(2) = dblPointinsertion(0) + sngLargeur / 2: dblPoints(3) = dblPointinsertion(1) + sngHauteur / 2
dblPoints(4) = dblPointinsertion(0) + sngLargeur / 2: dblPoints(5) = dblPointinsertion(1) - sngHauteur / 2
dblPoints(6) = dblPointinsertion(0) - sngLargeur / 2: dblPoints(7) = dblPointinsertion(1) - sngHauteur / 2

Set objRectangle = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblPoints)
With objRectangle
.Closed = True
.Update
End With

Dim sngTailleducadre As Single
sngTailleducadre = 30 * sngCoef
varOffset = objRectangle.Offset(-sngTailleducadre)
objRectangle.Delete



'ThisDrawing.Application.Documents.Close
Else

dblPoints(0) = varPointinsertion(0) - sngLargeur / 2: dblPoints(1) = varPointinsertion(1) + sngHauteur / 2
dblPoints(2) = varPointinsertion(0) + sngLargeur / 2: dblPoints(3) = varPointinsertion(1) + sngHauteur / 2
dblPoints(4) = varPointinsertion(0) + sngLargeur / 2: dblPoints(5) = varPointinsertion(1) - sngHauteur / 2
dblPoints(6) = varPointinsertion(0) - sngLargeur / 2: dblPoints(7) = varPointinsertion(1) - sngHauteur / 2
End If

Set objRectangle = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblPoints)
With objRectangle
.Closed = True
End With


Debug.Print booSCU
If booSCU = True Then

Dim TransMatrix As Variant
TransMatrix = ThisDrawing.ActiveUCS.GetUCSMatrix
objBloc.TransformBy (TransMatrix)
objRectangle.TransformBy (TransMatrix)

End If





sngTailleducadre = 30 * sngCoef
varOffset = objRectangle.Offset(-sngTailleducadre)
objRectangle.Delete

Exit Sub

Gestion:

Select Case Err.Number
Case "-2147352567"
      ThisDrawing.Utility.Prompt " Annulée par l'utilisateur."
Case Else
Debug.Print Err.Number, Err.Description
ThisDrawing.Utility.Prompt "Une erreur inconnue est survenue, veuillez contacter le développeur."
End Select
End Sub

lili2006 · le 1 novembre 2007

Bonjour à toutes et tous,

sechanbask, j'ai testé et j'ai le message suivant : (Il me semble avoir respecté tes consignes pour la création du bloc !).

 Set objBloc = ThisDrawing.ModelSpace.InsertBlock(dblPointinsertion, "Sect_rect_bloc.dwg", dbllargech#, dblhautech#, 1#, dblteta)

Merci d'avance.

sechanbask · le 1 novembre 2007

Il faut bien sûr que je donne mon fichier bloc:

http://cjoint.com/?lbvidWAloI

désolé pour l'oubli...

en fait çà ne coince pas à l'insertion mais juste après... le bloc n'est pas décomposé en bloc contenu dans le fichier bloc. Je fais ça pour que le bloc possède des unités cohérentes...

[Edité le 1/11/2007 par sechanbask]

lili2006 · le 1 novembre 2007

Re,

Merci de la réponse sechanbask, je teste ça demain et revient !

Bonne nuit.

mdsv31 · le 1 novembre 2007

Bon voila de nouveau le chieur.

La le code marche, mais (et ou il y a un mais sinon je ne serai pas le chieur de service) lorsque que je lance le code il me créé un nouveau fichier à chaque fois que je lance le programme.

La je ne comprend pas d'ou cela vient.

@+

MDSV31

J'avais oublié il me mais un message avec "Entrée incorrecte" et comme seul choix OK ou Aide

si je clic dans Aide rien ne ce passe et si je clique sur OK, j'ai un nouveau fichier avec un bloc avec la reservation.

PS: j'ai changer le nom du bloc avec celui de la section circulaire et il marche maintenant jusqu'au même moment qu'avec le bloc rectangulaire.

Sinon beau travail.

[Edité le 1/11/2007 par mdsv31]

sechanbask · le 1 novembre 2007

relis bien mon premier post, j'ai un problème...

si le bloc n'existe dans les dimensions indiqués (par exemple 500x500) ni dans les fichiers ni dans le plan, je souhaite utilise le fichier Sect_rect_bloc.dwg : coller le bloc qu'il contient dans un nouveau dessin l'exposer (pour éviter les bloc imbriqué (c'est là où j'ai un problème)) pour faire le contre cadre et puis après enregistrer ce nouveau dwg pour que le programme l'utilise pour l'insertion d'une trémie en un seul bloc... cette dernière partie n'est pas faite..

sechanbask · le 5 novembre 2007

je sais pourquoi je ne peux pas explosé mon bloc après l'insertion. Cela vient de la l'échelle que je lui applique à l'insertion... mais je ne comprends pas pourquoi..

Alors du coup, je vais contourner le problème et lui faire un pied de nez pour pas dire que je vais lui faire un bras d'honneur...

[Algorithme]

- Insertion du bloc sans échelle

- décomposition du bloc

- suppression du bloc-fichier

- échelle sur le bloc

Il me reste la gestion des SCU non-nommé que mon programme prends encore pour le SCG.

Sub Impact_rectangulaire()
Dim sngLargeur As Single
Dim sngHauteur As Single
Dim dblPoints(0 To 7) As Double
Dim objBloc As AcadBlockReference
Dim objRectangle As AcadLWPolyline
Dim objTriangle As AcadLWPolyline
Dim strUnitvar As String
Dim strUCS As String
Dim sngCoef As Single
Dim booSCU As Boolean
Dim dbllargech As Double
Dim dblhautech As Double
Dim dblteta As Double

On Error GoTo gestion

strUnitvar = ThisDrawing.GetVariable("INSUNITS")


sngCoef = 1



Select Case strUnitvar

Case 4
'(millimètre)
sngCoef = 1
Case 5
'(centimètre)
sngCoef = 0.1
Case 6
'(mètre)
sngCoef = 0.001
End Select




sngLargeur = ThisDrawing.Utility.GetReal("Veuillez entrer la largeur de la gaine en mm : ")
sngHauteur = ThisDrawing.Utility.GetReal("Veuillez entrer la hauteur de la gaine en mm : (Largeur entrée : " & sngLargeur & " mm)")

sngLargeur = sngLargeur * sngCoef
dbllargech = sngLargeur / 10
sngHauteur = sngHauteur * sngCoef
dblhautech = sngHauteur / 10

booSCU = False

Dim varPointinsertion As Variant
varPointinsertion = ThisDrawing.Utility.GetPoint(, "Indiquer le centre de l'impact: ")
Dim strSCU As String

On Error Resume Next

'strUCS = ThisDrawing.GetVariable("UCSXDIR")
'strUCS = ThisDrawing.GetVariable("UCSVP")
'ThisDrawing.GetVariable ("UCSNAME")

'MsgBox strUCS
strSCU = ThisDrawing.ActiveUCS.Name
Debug.Print Err.Number, "ok"
Select Case Err.Number
Case "-2145386481"
booSCU = False
Debug.Print "SCG"

Case "0"
varPointinsertion = ThisDrawing.Utility.TranslateCoordinates(varPointinsertion, acWorld, acUCS, False)
booSCU = True
Case Else
Debug.Print Err.Number, Err.Description, "ie"
ThisDrawing.Utility.Prompt "Une erreur inconnue est survenue, veuillez contacter le développeur."
Exit Sub
End Select
On Error GoTo 0





dblteta = 0

Set objBloc = ThisDrawing.ModelSpace.InsertBlock(varPointinsertion, "Sect_rec_bloc.dwg", 1#, 1#, 1#, dblteta)



Dim explodedObjects As Variant
  explodedObjects = objBloc.Explode
  
objBloc.Delete
        Dim I As Integer
  For I = 0 To UBound(explodedObjects)
      explodedObjects(I).XScaleFactor = dbllargech
      explodedObjects(I).YScaleFactor = dblhautech
      explodedObjects(I).ZScaleFactor = 1
      explodedObjects(I).Update
             'Dim objBlock As AcadBlock
             If explodedObjects(I).ObjectName = "AcDbBlockReference" Then
             Debug.Print explodedObjects(I).ObjectName
             Set objBloc = explodedObjects(I)
             End If
             Next
  
  
  
  


dblPoints(0) = varPointinsertion(0) - sngLargeur / 2: dblPoints(1) = varPointinsertion(1) + sngHauteur / 2
dblPoints(2) = varPointinsertion(0) + sngLargeur / 2: dblPoints(3) = varPointinsertion(1) + sngHauteur / 2
dblPoints(4) = varPointinsertion(0) + sngLargeur / 2: dblPoints(5) = varPointinsertion(1) - sngHauteur / 2
dblPoints(6) = varPointinsertion(0) - sngLargeur / 2: dblPoints(7) = varPointinsertion(1) - sngHauteur / 2

Set objRectangle = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblPoints)
With objRectangle
.Closed = True
End With



If booSCU = True Then

Dim TransMatrix As Variant
TransMatrix = ThisDrawing.ActiveUCS.GetUCSMatrix
objBloc.TransformBy (TransMatrix)
objRectangle.TransformBy (TransMatrix)

End If

Dim varOffset As Variant


Dim sngTailleducadre As Single
sngTailleducadre = 30 * sngCoef
varOffset = objRectangle.Offset(-sngTailleducadre)
objRectangle.Delete

Exit Sub

gestion:

Select Case Err.Number
Case "-2147352567"
      ThisDrawing.Utility.Prompt " Annulée par l'utilisateur."
Case Else
Debug.Print Err.Number, Err.Description
ThisDrawing.Utility.Prompt "Une erreur inconnue est survenue, veuillez contacter le développeur."
End Select
End Sub

[Edité le 5/11/2007 par sechanbask]

lili2006 · le 5 novembre 2007

Bonjour à toutes et tous,

sechanbask, sacré pied de nez, ça marche parfaitement.

Bravo et encore merci pour ce partage.

speedy · le 5 novembre 2007

Bonjour à tous

pourriez vous m'expliquer la procédure de création de la gaine...

1- j'ai inséré le bloc sect_rec...,

2- j'ai collé le code vba

3-exécuter le code, saisie les infos largeur et hateur de la gaine, indiquer ... erreur..

ça correspond à quoi "indiquer le centre de l'impact" ???

est ce le point de départ ??

@+

Michel a

lili2006 · le 5 novembre 2007

Re,

Je me permet de répondre à la place de sechanbask.

1- j'ai inséré le bloc sect_rec...,

Pas besoin, tu le met juste sur un dossier de support AutoCAD.

2- j'ai collé le code vba

Outils => macros => charger.

ça correspond à quoi "indiquer le centre de l'impact" ???

C'est le centre du bloc.

Bon courage.

speedy · le 5 novembre 2007

Bonjour lili

c'est un fichier texte pour le charger il faudrait qu'il soit en dvb, j'ai essayé de cliquer sur le centre du bloc rien à faire, comment as tu fait pour créer une gaine rectangulaire, j'ai même essayé le circulaire idem toujours erreur à l'indication du point ??

j'aimerais comprendre la méthode...

@+

Michel a

lili2006 · le 5 novembre 2007

Re,

c'est un fichier texte pour le charger il faudrait qu'il soit en dvb

Pour copier le code tu fais :

1) Outils => macro VBA => Editeur visual basic

2) Dans Microsoft Visual Basic, tu fais => Insertion => Module

3) Fichier enregistrer, tu lui donne le nom du code (exemple ici : Impact_rectangulaire)

4) Tu défini to dossier support pour le code VBA et le fichier .dwg

5) Tu charges la macro VBA => Outils => Macro VBA => Exécuter et c'est parti.

j'ai même essayé le circulaire idem toujours erreur à l'indication du point ??

Même méthode que ci-dessus.

@+,

sechanbask · le 5 novembre 2007

lili2006 tu es devenu un vrai pro pour le chargement VBA... chapeau

speedy · le 5 novembre 2007

Re

ce n'est pas la question, le code vba fonctionne, mais c'est au niveau de l'éxécution aprés indication de largeur et hateur de la gaine, "indiquer le centre de l'impact" je clique eur le bloc et j'ai erreur de fichier ???

je clique ou à la dernière requête ? comment se construit cette gaine ??

@+

Michel a

lili2006 · le 5 novembre 2007

Re,

A l'insertion, voici ton bloc :

je clique eur le bloc et j'ai erreur de fichier ???

Justement, il ne faut pas cliquer sur le bloc, tu l'insères dans l'EO là ou tu en as besoin .

Je viens de refaire les manips, pas de pb chez moi, je suis désolé car pas assez calé pour savoir d'ou ça vient,.... sechanbask, peut-être ???

sechanbask, merci pour le compliment, mais j'ai uniquement repri le plan de tes explications.

speedy · le 6 novembre 2007

Bonjour à tous

voici l'affichage de l'erreur :

http://images2.hiboox.com/images/4507/vugk3x3g.jpg

la question est pour sechanbask, j'ai esayé tes deux vba (circulaire et rectangle) même erreur ?? d'ou peut provenir cette erreur ??

@+

Michel a

sechanbask · le 6 novembre 2007

tu essaies la macro dans un fichier vierge où dans le fichier que j'ai envoyé ?

speedy · le 6 novembre 2007

salut

j'ai fait l'essai dans un fichier vierge, j'insère le bloc sect..., puis j'éxécute la macro...

voilà

@+

Michel a

sechanbask · le 6 novembre 2007

tu l'a pas la peine d'insérer le bloc, ma macro le fait tout seul... si le fichier "Sect_rect_bloc.dwg" est dans un répertoire lié à autocad...

si malgré un suivit à la lettre des instructions de lili2006 (voir message 11) tu as un problème remplace dans le code

"on error goto gestion" par "on error goto 0", comme ça tu pourras me dire sur quel ligne le programme s'arrête.

P.S. tu possèdes quelle version d'autocad ??

P.P.S. quelles sont les unités de ton nouveau plan?

[Edité le 6/11/2007 par sechanbask]

speedy · le 6 novembre 2007

RE

Sechanbask, en vba je bricole depuis un moment, mais là je cherche l'erreur,

autocad 2007

sans unité

quand je fait pas à pas voici l'erreur aprés insertion erreur....

http://images2.hiboox.com/images/4507/7sd4suyk.jpg

@+

Michel a

sechanbask · le 6 novembre 2007

essaie de de faire ça sur un plan en MM, CM ou M, et si ça marche toujours pas donne moi la ligne où se situe l'erreur STP...

moi aussi je sèche un peu...

le .dvb est bien dans un dossier lié à autocad?car parfois on peux utiliser une macro qui plante quasiment à chaque coup car le projet n'est pas dans un dossier support... c'est d'ailleurs bizarre qu'on puisse la lancer...

speedy · le 7 novembre 2007

Bonjour à tous

sechambask peux tu poster le dvb, mes codes fonctionne je voudrais comprendre pourquoi ça marche pas ....

@+

Michel a

sechanbask · le 7 novembre 2007

je t'avouerais que j'ai plein de projet sur ce .DVB qui sont pas encore solides alors je le posterais après avoir scindés mes modules... je devrais le faire ce soir et quand le programme marchera, je demanderai à Patrick de le mettre dans téléchargement...

@+

sechanbask · le 8 novembre 2007

j'ai regardé mon dvb et j'ai aucune dépendance, aucune déclaration extérieur ou générale, alors je le posterais quand j'aurais un peu plus de temps... désolé

Connexion

Problème sur insertion de bloc

Messages recommandés

sechanbask

lili2006

sechanbask

lili2006

mdsv31

sechanbask

sechanbask

lili2006

speedy

lili2006

speedy

lili2006

sechanbask

speedy

lili2006

speedy

sechanbask

speedy

sechanbask

speedy

sechanbask

speedy

sechanbask

sechanbask

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante