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 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
|
Sub Extractionptinsertion()
Dim applicationexcel As Object ' dimension variable application excel
Set applicationexcel = GetObject(, "excel.Application") ' On récupère l'objet Application
applicationexcel.Visible = True ' on le rend visible
monfichier = applicationexcel.ActiveWorkbook.Name 'definition de la variable monfichier = variable application excel, classeur actif + le nom
applicationexcel.Workbooks(monfichier).Activate ' on active le fichier
Set ongletexcel = applicationexcel.Workbooks(monfichier).Worksheets("Injectionbloclocal") 'on va chercher l'onglet qui nous interresse
'Dimension des variables autocad à prendre en compte
Dim Textes As AcadText
Dim Objets As AcadEntity
Dim tt As String
' action autocad (document actif)
Set Applicationautocad = AutoCAD.Documents.Application.ActiveDocument
'On commence à la ligne
Ligne = 5
ongletexcel.Cells(1, 1).Value = ThisDrawing.Path + "\" + ThisDrawing.Name
ongletexcel.Cells(2, 1).Value = ThisDrawing.Path
ongletexcel.Cells(3, 1).Value = ThisDrawing.Name
ongletexcel.Cells(4, 1).Value = "Label"
ongletexcel.Cells(4, 2).Value = "Position X"
ongletexcel.Cells(4, 3).Value = "Position Y"
ongletexcel.Cells(4, 4).Value = "Rotation"
ongletexcel.Cells(4, 5).Value = "Calques"
ongletexcel.Cells(4, 6).Value = "Hauteur du texte"
For Each Objets In Applicationautocad.ModelSpace ' pour chaque "varible objets" dans la variable "application autocad" dans l'espace objet
tt = Objets.ObjectName
If tt = "AcDbText" Then
Set Textes = Objets
If Textes.Layer = "CODE_PIECE" Then
'Set Textes = Textes.TextAlignmentPoint("left")
'Textes.Alignment = acAttachmentPointleft
ongletexcel.Cells(Ligne, 1).Value = Textes.TextString
ongletexcel.Cells(Ligne, 2).Value = Textes.InsertionPoint(0)
ongletexcel.Cells(Ligne, 3).Value = Textes.InsertionPoint(1)
ongletexcel.Cells(Ligne, 4).Value = Textes.Rotation
ongletexcel.Cells(Ligne, 5).Value = Textes.Layer
ongletexcel.Cells(Ligne, 6).Value = Textes.Height
On Error Resume Next
Ligne = Ligne + 1
Else
End If
Else
End If
Next Objets
'On recommence pour les gaines
Set ongletexcel = applicationexcel.Workbooks(monfichier).Worksheets("Injectionblocgaine") 'on va chercher l'onglet qui nous interresse
Ligne = 5
ongletexcel.Cells(1, 1).Value = ThisDrawing.Path + "\" + ThisDrawing.Name
ongletexcel.Cells(4, 1).Value = "Label"
ongletexcel.Cells(4, 2).Value = "Position X"
ongletexcel.Cells(4, 3).Value = "Position Y"
ongletexcel.Cells(4, 4).Value = "Rotation"
ongletexcel.Cells(4, 5).Value = "Calques"
ongletexcel.Cells(4, 6).Value = "Hauteur du texte"
For Each Objets In Applicationautocad.ModelSpace ' pour chaque "varible objets" dans la variable "application autocad" dans l'espace objet
tt = Objets.ObjectName
If tt = "AcDbText" Then
Set Textes = Objets
If Textes.Layer = "02B_gaines_num" Then
'Set Textes = Textes.TextAlignmentPoint("left")
ongletexcel.Cells(Ligne, 1).Value = Textes.TextString
ongletexcel.Cells(Ligne, 2).Value = Textes.InsertionPoint(0)
ongletexcel.Cells(Ligne, 3).Value = Textes.InsertionPoint(1)
ongletexcel.Cells(Ligne, 4).Value = Textes.Rotation
ongletexcel.Cells(Ligne, 5).Value = Textes.Layer
ongletexcel.Cells(Ligne, 6).Value = Textes.Height
On Error Resume Next
Ligne = Ligne + 1
Else
End If
Else
End If
Next Objets
ZoomExtents 'Zoom etendu
ThisDrawing.PurgeAll 'pour purger le dessin en cours
'ThisDrawing.ModelSpace.Regen 'on regen
ThisDrawing.Save 'on sauvegarde
ThisDrawing.Close 'on ferme
'fermeture.fermeture 'envois vers le module de fermeture
MsgBox "Le fichier excel créé est à enregistrer dans le dossier en cours de traitement"
End Sub |
Partager