Macro Excel qui active des fonctions Autocad

Version imprimable

12/05/2015, 14h28
a23peter43

Macro Excel qui active des fonctions Autocad

Bonjour à tous !
Etant assez novice en programmation, j'ai quelques difficultés concernant une macro qui me permettrait de réaliser la fonction "insérer bloc" dans la feuille active d'autocad.
Je sais que le code doit surement ressembler à quelque chose dans ce style

Code:

AcadApp.ActiveDocument.SendCommand "(insert ""Nom du répertoire"")"

Mais il faudrait qu'en plus de l'insérer, on ai le choix du point d'insertion et de l'orientation du bloc.
J'ai essayé avec filedia 0 pour avoir les lignes de commandes mais je n'arrive pas à extraire le code et je ne trouve pas grand chose à ce sujet sur internet.
Si vous pouvez m'éclairez :?

Pierre

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
Sub blocktest()
 Dim oBlkRef As AcadBlockReference
 Dim position(2) As Double
 Dim sName As String
position(0)= 1500
position(1)=200
 
 sName = "c:\testblock.dwg"
 Set oBlkRef = AcadApp.ThisDrawing.ModelSpace.InsertBlock(position, sName, 1#, 1#, 1#, 0#)
 End Sub

13/05/2015, 08h17
a23peter43

Bonjour,
Merci pour la réponse !
J'ai rentré les lignes de code dans un module mais j'obtiens une erreur que j'avais à chaque fois lors des différents test que j'ai fait, c'est à dire "Erreur de compilation, type non défini par l'utilisateur" dès la ligne 2
D'où viens cette erreur ?

Pierre

Bonjour,
Si tu n'as pas cocher la case AutoCAD dans les références! C'est normal.
Utilise la méthode creatobject("autocad.application")

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub blocktest()
Dim AcadApp as object
 Dim oBlkRef As object
 Dim position(2) As Double
 Dim sName As String
position(0)= 1500
position(1)=200
 
 sName = "c:\testblock.dwg"
AcadApp = creatobject("autocad.application")
AcadApp.visible=true
Dim doc
Set doc=AcadApp.documents.add
 Set oBlkRef = doc.ModelSpace.InsertBlock(position, sName, 1#, 1#, 1#, 0#)
 End Sub

Bonjour,
J'ai modifier le code pour qu'il corresponde à mon problème mais malheureusement cela ne marche toujours pas..J'ai bien activer toutes les références Autocad
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Autocadt() Dim AcadApp as object Dim oBlkRef As object Dim position(2) As Double Dim sName As String position(0)= 1500 position(1)=200 sName = "c:\testblock.dwg" AcadApp = CreateObject("autocad.application") AcadApp.visible=true Dim doc Set doc=AcadApp.documents.add Set oBlkRef = doc.ModelSpace.InsertBlock(position, sName, 1#, 1#, 1#, 0#) End Sub
J'ai l'erreur 91: Variable objet ou variable de bloc WITH non définie
A quoi sert la fonction Createobject ? Enfin que fait-elle exactement ? C'est cette ligne qui à l'air de ne pas fonctionner lorsque j’exécute le programme..
Cordialement

18/05/2015, 11h21
Invité

bonjour,
avec ce code tu n'as pas à activer les différences!
dessolé! set AcadApp = CreateObject("AutoCAD.Application").
CreateObject créer une nouvelle instance d'autocad!

CreateObject("AutoCAD.Application") permet d'utiliser AutoCad sans tenir compte de la version et donc sans activer les références!
18/05/2015, 11h38
a23peter43

On y arrive petit à petit, la macro s’exécute mais il m'ouvre Autocad 2012 alors que j'ai le 2015 d'ouvert et ne me permet toujours pas d’insérer le bloc à l'endroit que je veux. Enfin la macro ouvre deux feuilles Autocad mais rien d'autre se passe lorsque je me met sur les feuilles..

tu as plusieurs version d'AutoCad sur ta machine,
AutoCad est toujours ouvert quand tu exécute la macro?
Code:

1 2 3 4 5 on error resume next set AcadApp =getObject(,"AutoCAD.Application") if err<>0 then set AcadApp = CreateObject("AutoCAD.Application") on error goto 0 Set doc=AcadApp.ThisDrawing

Il faut croire que j'en ai plusieurs oui. Et Autocad sera toujours ouvert lorsque la macro sera exécuté.
J'ai peut être un autre code en m'inspirant d'autre Excel présent sur le serveur mais celui-ci ne fonctionne pas non plus
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub Autocadt() Dim acadApp As AutoCAD.AcadApplication Dim this_drawing As New AcadDocument Dim Chemin As String Dim BlocRef As AcadBlockReference Set acadApp = AutoCAD.AcadApplication Chemin = "S:\OUTILS\Blocs\21462\50\50_E_dess.dwg" 'Insertion du bloc Dim insert_point(0 To 2) As Double insert_point(0) = x: insert_point(1) = y: insert_point(2) = 0: 'initialisation du bloc avec le point d'insertion et chemin d'accès Set ligne_rep = acadApp.ActiveDocument.PaperSpace.InsertBlock(insert_point, Chemin, 1#, 1#, 1#, 0) End Sub
Je teste le bout de code que tu m'as donné, merci encore

En mettant juste ce petit bout de code, j'arrive à insérer le bloc, cependant je ne peux pas gérer la position, l'angle, l'échelle... Par contre, cela se met bien sur AutoCad 2015 lorsque je lance la macro
Code:

1 2 3 4 5 6 7 8 Sub Test Dim insert_point(0 To 2) As Double Dim console As AcadEntity insert_point(0) = xfc1: insert_point(1) = yfc1 + e1: insert_point(2) = 0: Set console = AutoCAD.AcadApplication.ActiveDocument.ModelSpace.InsertBlock(insert_point, "S:\OUTILS\50_E_dess.dwg", 1#, 1#, 1#, 0) End Sub
J'essaye de trouver la fonction avec AcadApp.Activedocument.SendCommand mais je ne sais pas du tout comment elle marche

19/05/2015, 11h59
Invité

Citation:

Envoyé par a23peter43

En mettant juste ce petit bout de code, j'arrive à insérer le bloc, cependant je ne peux pas gérer la position, l'angle, l'échelle... Par contre, cela se met bien sur AutoCad 2015 lorsque je lance la macro

J'essaye de trouver la fonction avec AcadApp.Activedocument.SendCommand mais je ne sais pas du tout comment elle marche

il faut te placer dans AutoCad faire ton insertion de bloc; puis copier coller la commande dans l'historique des commandes; tu sais quand dans AutoCad tu veux ré-exécuter les commande précédant; tu palace le tous sur une seule ligne et tu n'oblis pas le retour chariot!

Code:

cadApp.Activedocument.SendCommand "Ma Commande" & vbcrlf

C'est bon j'ai trouver la solution grace à un forum anglais

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Dim acadApp As AcadApplication
    Dim acadDoc As AcadDocument
 
    'Check if AutoCAD is open.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
        'If AutoCAD is not opened ask to open first.
    If acadApp Is Nothing Then
        Set acadApp = New AcadApplication
        acadApp.Visible = True
    End If
        'Check if there is an active drawing.
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    On Error GoTo 0
        'No active drawing found. Create a new one.
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
        acadApp.Visible = True
    End If
acadApp.ActiveDocument.SendCommand "-i" & vbCr & "S:\OUTILS\50_E_dess.dwg" & vbCr
 
End Sub

Je te remercie rdurupt pour avoir pris le temps de me trouver des bouts de code :)