Guys,
In AutoCAD if you offset an ellipse, the new object formed would be a spline, not an ellipse. I had a project in which I have to offset so many ellipses. It was too sad that I used to get splines instead of ellipse. So, I thought of writing a macro.
It is working perfectly and thought of sharing it. You will defenitely be able to have better suggestions after seeing the code, as I am not a master in VBA. Please feel free to feedback.
Here is the code.
Code:
Public Sub EllipseOffset()
On Error Resume Next
Dim El As AcadEllipse
Dim NEL As AcadEllipse
Dim C As Variant
Dim Center(0 To 2) As Double
Dim MjAx As Variant
Dim MiAx As Variant
Dim MajorAx(0 To 2) As Double
Dim MinorAx(0 To 2) As Double
Dim RadRatio As Double
Dim MajorRad, MinorRad As Double
Dim En As AcadEntity
Dim PkPnt As Variant
Dim Offset As Double
Dim InOut As String
Dim kwordList As String
Dim RepeatMacro As Boolean
Dim RepNum As Integer
Dim ConVal As Double
RepeatMacro = False
kwordList = "Inside Outside Multiple Repeat"
Repeat:
ThisDrawing.Utility.GetEntity En, Pk, "Select Ellipse:"
If Err Then Exit Sub
Offset = ThisDrawing.Utility.GetDistance(, "Offset:<" & ConVal & ">")
If Err Then Err.Clear
If Offset = 0 Then
Offset = 1
Else
ConVal = Round(Offset, 4)
End If
If Offset < 0 Then
Offset = Offset * -1
End If
If TypeOf En Is AcadEllipse Then
Set El = En
C = El.Center
Center(0) = C(0)
Center(1) = C(1)
Center(2) = C(2)
MjAx = El.MajorAxis
MiAx = El.MinorAxis
MajorAx(0) = MjAx(0)
MajorAx(1) = MjAx(1)
MajorAx(2) = MjAx(2)
MinorAx(0) = MiAx(0)
MinorAx(1) = MiAx(1)
MinorAx(2) = MiAx(2)
MajorRad = El.MajorRadius
MinorRad = El.MinorRadius
RadRatio = El.RadiusRatio
Break:
ThisDrawing.Utility.InitializeUserInput 1, kwordList
If RepeatMacro = False Then
InOut = ThisDrawing.Utility.GetKeyword("Enter an option (Inside,Outside,Multiple, Repeat): ")
End If
If RepeatMacro = True Then
InOut = ThisDrawing.Utility.GetKeyword("Enter an option (Inside,Outside,Multiple): ")
End If
If InOut = "Repeat" Then
kwordList = "Inside Outside Multiple"
RepeatMacro = True
GoTo Break
End If
If InOut = "Inside" Then
Set NEL = ThisDrawing.ModelSpace.AddEllipse(Center, MajorAx, RadRatio)
NEL.MajorRadius = MajorRad - Offset
NEL.MinorRadius = MinorRad - Offset
NEL.RadiusRatio = (MinorRad - Offset) / (MajorRad - Offset)
End If
If InOut = "Outside" Then
Set NEL = ThisDrawing.ModelSpace.AddEllipse(Center, MajorAx, RadRatio)
NEL.MajorRadius = MajorRad + Offset
NEL.MinorRadius = MinorRad + Offset
NEL.RadiusRatio = (MinorRad + Offset) / (MajorRad + Offset)
End If
If InOut = "Multiple" Then
RepNum = ThisDrawing.Utility.GetInteger("Number of Offsets: ")
ThisDrawing.Utility.InitializeUserInput 1, kwordList
InOut = ThisDrawing.Utility.GetKeyword("Enter an option (Inside,Outside): ")
Set NEL = ThisDrawing.ModelSpace.AddEllipse(Center, MajorAx, RadRatio)
MjAx = NEL.MajorAxis
MiAx = NEL.MinorAxis
MajorAx(0) = MjAx(0)
MajorAx(1) = MjAx(1)
MajorAx(2) = MjAx(2)
MajorRad = NEL.MajorRadius
MinorRad = NEL.MinorRadius
RadRatio = NEL.RadiusRatio
If Not RepNum = 1 Then
For i = 1 To RepNum
If InOut = "Inside" Then
Set NEL = ThisDrawing.ModelSpace.AddEllipse(Center, MajorAx, RadRatio)
NEL.MajorRadius = MajorRad - Offset
NEL.MinorRadius = MinorRad - Offset
NEL.RadiusRatio = (MinorRad - Offset) / (MajorRad - Offset)
MjAx = NEL.MajorAxis
MiAx = NEL.MinorAxis
MajorAx(0) = MjAx(0)
MajorAx(1) = MjAx(1)
MajorAx(2) = MjAx(2)
MajorRad = NEL.MajorRadius
MinorRad = NEL.MinorRadius
RadRatio = NEL.RadiusRatio
End If
If InOut = "Outside" Then
Set NEL = ThisDrawing.ModelSpace.AddEllipse(Center, MajorAx, RadRatio)
NEL.MajorRadius = MajorRad + Offset
NEL.MinorRadius = MinorRad + Offset
NEL.RadiusRatio = (MinorRad + Offset) / (MajorRad + Offset)
MjAx = NEL.MajorAxis
MiAx = NEL.MinorAxis
MajorAx(0) = MjAx(0)
MajorAx(1) = MjAx(1)
MajorAx(2) = MjAx(2)
MajorRad = NEL.MajorRadius
MinorRad = NEL.MinorRadius
RadRatio = NEL.RadiusRatio
End If
Next
End If
End If
Update
End If
If RepeatMacro = True Then
GoTo Repeat
End If
End Sub