camillenathan
Messages postés1Date d'inscriptionlundi 23 mars 2015StatutMembreDernière intervention23 mars 2015
-
23 mars 2015 à 15:06
Bonjour,
Je m'appelle Camille et je suis actuellement en licence projeteur CAO/DAO. J'ai un projet à réaliser en cours et notre prof étant souvent absent, je trouve quelques difficultés à terminer mon projet.
Voilà je dois automatiser un plan de phasage d'excel vers autocad : le planning se fait sur Excel et les phases sur Autocad. J'aurai besoin d'aide pour insérer automatiquement une polyligne dans un calque à partir d'un UserForm sur autocad.
Dans ce userform, il y a une liste déroulante qui va chercher son contenu dans mon planning excel. Voici le programme :
Private Sub UserForm_Initialize()
Dim ExcelApp As Object, ExcelSheet As Worksheet, cellule As Range
On Error Resume Next
'ExcelApp est un lien sur l'application excel en cours
Set ExcelApp = GetObject(, "Excel.application")
'ExcelSheet est un lien sur la feuille de calcul nommée Feuil1
Set ExcelSheet = ExcelApp.activeworkbook.sheets("RESULTATS")
If Err.Number <> 0 Then
MsgBox ("Attention le classeur 'PLANNING' n'est pas ouvert")
Exit Sub
End If
For Each cellule In ExcelSheet.Range("C3:C108")
If cellule.Value = "" Then Exit For
ChoixSousPhase.AddItem (cellule.Value)
Next
'ExcelApp est un lien sur l'application excel en cours
Set AcadApp = GetObject(, "Autocad.application")
End Sub
Il y a également un bouton qui permet de dessiner la polyligne (le programme est en dessous). Et j'aimerai que cette polyligne se range dans un calque qui porte le nom que l'utilisateur aura choisi dans la liste déroulante.
Quelqu'un peut-il m'aider svp ...
programme polyligne :
Private Sub CommandButton1_Click()
' This example creates a lightweight polyline in model space.
Dim plineObj As AcadLWPolyline
Dim points() As Double
Dim UnPoint As Variant, NumPoint As Integer
Dim P1(0 To 2) As Double, P2(0 To 2) As Double
On Error Resume Next
Me.Hide
'AcadApp.Visible = True
NumPoint = 0
Do
UnPoint = ThisDrawing.Utility.GetPoint(, "Point suivant :")
If Err.Number = 0 Then
ReDim Preserve points(NumPoint * 2 + 1)
points(NumPoint * 2) = UnPoint(0): points(NumPoint * 2 + 1) = UnPoint(1)
If NumPoint > 0 Then
P1(0) = points((NumPoint - 1) * 2): P1(1) = points((NumPoint - 1) * 2 + 1): P1(2) = 0#
P2(0) = points(NumPoint * 2): P2(1) = points(NumPoint * 2 + 1): P2(2) = 0#
Call ThisDrawing.ModelSpace.AddLine(P1, P2)
End If
NumPoint = NumPoint + 1
Else
Exit Do
End If
Loop Until False
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
ZoomAll