A voir également:
- VBA - autoCAD
- Telecharger autocad - Télécharger - CAO-DAO
- Find vba - Astuces et Solutions
- Incompatibilité de type vba ✓ - Forum Programmation
- Vba attendre 1 seconde ✓ - Forum VB / VBA
- Vba dernière colonne non vide ✓ - Forum VB / VBA
1 réponse
Sub Example_Layer()
' This example creates a new layer named "ABC" (colored blue).
' It then creates a circle and assigns it to layer "ABC"
' Create new layer
Dim layerObj As AcadLayer
Set layerObj = ThisDrawing.Layers.Add("ABC")
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call color.SetRGB(80, 100, 244)
layerObj.TrueColor = color
' Create Circle
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 3: center(1) = 3: center(2) = 0
radius = 1.5
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomAll
MsgBox "The circle has been created on layer " & circleObj.Layer, , "Layer Example"
' Set the layer of new circle to "ABC"
circleObj.Layer = "ABC"
' Refresh view
ThisDrawing.Regen (True)
MsgBox "The circle is now on layer " & circleObj.Layer, , "Layer Example"
End Sub
cette procédure ne marche pas cela me met une erreur au niveau de "this drawing"
' This example creates a new layer named "ABC" (colored blue).
' It then creates a circle and assigns it to layer "ABC"
' Create new layer
Dim layerObj As AcadLayer
Set layerObj = ThisDrawing.Layers.Add("ABC")
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call color.SetRGB(80, 100, 244)
layerObj.TrueColor = color
' Create Circle
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 3: center(1) = 3: center(2) = 0
radius = 1.5
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomAll
MsgBox "The circle has been created on layer " & circleObj.Layer, , "Layer Example"
' Set the layer of new circle to "ABC"
circleObj.Layer = "ABC"
' Refresh view
ThisDrawing.Regen (True)
MsgBox "The circle is now on layer " & circleObj.Layer, , "Layer Example"
End Sub
cette procédure ne marche pas cela me met une erreur au niveau de "this drawing"
