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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
|
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim A(0 To 2) As Double, B(0 To 2) As Double
Dim AutoCAD As Object
Dim textobj As Object
Dim blnrunning As Boolean ' Si Autocad était en exécution
Dim xo, yo As Double 'point origine d'insertion des éléments
'coordonnées du point origine d'insertion des éléments
xo = 0
yo = 100
' Déroutement des erreurs
On Error Resume Next
'
' Référencer l'application Autocad
AutoCAD = GetObject(, "Autocad.Application")
If Err.Number <> 0 Then
AutoCAD = CreateObject("Autocad.Application")
blnrunning = False ' Excel n'était pas en exécution
Else
blnrunning = True
End If
AutoCAD.documents.open("C:\Documents and Settings\All Users\Bureau\Dessinbase.dwg")
'--------------------------------------------------------------------------------------------------
'1 - Insertion d'une ligne
'-------------------------
A(0) = 0 : A(1) = 1 : A(2) = 0
B(0) = 100 : B(1) = 100 : B(2) = 0
AutoCAD.Application.ActiveDocument.ModelSpace.AddLine(A, B)
'2 - Insertion d'un texte
'------------------------
textobj = AutoCAD.Application.ActiveDocument.ModelSpace.Addtext("toto", A, 5)
' textobj.TextAlignment = "alignmentPoint" ????? Ne fonctionne pas!
' textobj.acAttachmentPointMiddle() ????? Ne fonctionne pas!
textobj.update()
'3 - Insertion d'un bloc
'-----------------------
' Define the block
Dim blockObj As Object
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0
insertionPnt(1) = 0
insertionPnt(2) = 0
blockObj = AutoCAD.Application.ActiveDocument.Blocks.Add(insertionPnt, "BlockWithAttribute")
' Add an attribute to the block
Dim attributeObj As Object
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
height = 1
prompt = "New Prompt"
insertionPoint(0) = 5
insertionPoint(1) = 5
insertionPoint(2) = 0
tag = "New Tag"
value = "New Value"
blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
' Insert the block, creating a block reference and an attribute reference
insertionPnt(0) = 2
insertionPnt(1) = -10
insertionPnt(2) = 0
AutoCAD.Application.ActiveDocument.ModelSpace.InsertBlock(insertionPnt, "BlockWithAttribute", 1.0#, 1.0#, 1.0#, 0)
'--------------------------------------------------------------------------------------------------
'Enregistrer et quitter
AutoCAD.Visible = True
AutoCAD.Application.ZoomExtents()
AutoCAD.ActiveDocument.SaveAs("C:\Documents and Settings\All Users\Bureau\essai.dwg")
AutoCAD.ActiveDocument.close()
' Ne pas quitter si Autocad était déjà lancé !
If Not (blnrunning) Then ' S'il n'était pas lancé...
AutoCAD.Quit() ' alors quitter Autocad
End If
MsgBox("fini")
'End If
End Sub |
Partager