Author Topic: Reverse the normal of an arc??  (Read 2556 times)

0 Members and 1 Guest are viewing this topic.

DaveW

  • Guest
Reverse the normal of an arc??
« on: August 03, 2006, 11:41:48 PM »
Does anyone have some code that they can share that will reverse the normal of an arc to 0,0,1, if the original arc is 0,0,-1?

Thanks,

Dave

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Reverse the normal of an arc??
« Reply #1 on: August 04, 2006, 12:04:10 AM »
Dave I think there are 3 thinks that dont respond to changing the normal. Arc, region, something.
You have to make a new one, very annoying.
Please sift through the code below.
Code: [Select]
Sub FlattenThis(Ent As AcadEntity)
   
    Dim obj As AcadEntity
    Dim oLine As AcadLine
    Dim oMline As AcadMLine
    Dim oCirc As AcadCircle
    Dim oarc As AcadArc
    Dim oEll As AcadEllipse
    Dim oPline As AcadLWPolyline
    Dim oHatch As AcadHatch
    Dim oSpline As AcadSpline
    Dim oReg As AcadRegion
    Dim oPoint As AcadPoint
    Dim oBref As AcadBlockReference
    Dim oMt As AcadMText
    Dim oLeader As AcadLeader
    Dim Atts, Att
    Dim P1, P2, P3
    Dim Min, Max
    Dim ins, Cen
    Dim Zero(2) As Double, El(2) As Double
    Dim i As Integer
    Dim oFace As Acad3DFace
   

   If TypeOf Ent Is AcadLine Then
       Set oLine = Ent
       oLine.Thickness = 0
       oLine.StartPoint = Z0(oLine.StartPoint)
       oLine.EndPoint = Z0(oLine.EndPoint)
       If oLine.Length = 0 Then oLine.Delete
   ElseIf TypeOf Ent Is AcadMLine Then
       Set oMline = Ent
       P1 = oMline.Coordinates
       If P1(2) = P1(5) Then
           If P1(2) <> 0 Then
               El(2) = P1(2)
               oMline.Move El, Zero
           End If
       End If

   ElseIf TypeOf Ent Is AcadCircle Then
       Set oCirc = Ent
       oCirc.Thickness = 0
       If N1(oCirc) Then
           oCirc.center = Z0(oCirc.center)
       End If
   ElseIf TypeOf Ent Is AcadArc Then
       Set oarc = Ent
       If oarc.center(2) <> 0 Then
            If isN(oarc) Then
                oarc.Thickness = 0
                If N1(oarc) Then
                    oarc.center = Z0(oarc.center)
                End If
            End If
       End If
   ElseIf TypeOf Ent Is AcadEllipse Then
       Set oEll = Ent
       
       If N1(oEll) Then
       Cen = oEll.center
       If Cen(2) <> 0 Then
           oEll.center = Z0(Cen)
        End If
           
       End If
   ElseIf TypeOf Ent Is AcadLWPolyline Then
       Set oPline = Ent
       oPline.Thickness = 0
       If N1(oPline) Then
           oPline.Elevation = 0
       End If
   ElseIf TypeOf Ent Is AcadHatch Then
       Set oHatch = Ent
       If N1(oHatch) Then
           oHatch.Elevation = 0
       End If
   ElseIf TypeOf Ent Is AcadSpline Then
       Set oSpline = Ent
       If oSpline.IsPlanar Then
           P1 = oSpline.FitPoints
           If UBound(P1) < 5 Then
               P1 = oSpline.ControlPoints
           End If
           
           If P1(2) = P1(5) Then
               El(2) = P1(2)
               oSpline.Move El, Zero
           End If
       End If
   ElseIf TypeOf Ent Is Acad3DPolyline Then
       Dim oP3d As Acad3DPolyline
       Set oP3d = Ent
   
       'yada
   ElseIf TypeOf Ent Is AcadRegion Then
       Set oReg = Ent
       If N1(oReg) Then
           Ent.GetBoundingBox Min, Max
           If Rd(Min(2), Max(2)) Then
               Max = Min
               Max(2) = 0
               Ent.Move Min, Max
           End If
       End If
  ElseIf TypeOf Ent Is AcadPoint Then
       Set oPoint = Ent
       oPoint.Coordinates = Z0(oPoint.Coordinates)
   ElseIf TypeOf Ent Is AcadBlockReference Then
       Set oBref = Ent
       ins = oBref.InsertionPoint
       If ins(2) <> 0 Then
            If N1(oBref) Then
                oBref.InsertionPoint = Z0(ins)
                If oBref.HasAttributes Then
                    Atts = oBref.GetAttributes
                    For Each Att In Atts
                        Att.InsertionPoint = Z0(Att.InsertionPoint)
                        'Att.TextAlignmentPoint = Z0(Att.TextAlignmentPoint)
                    Next
                End If
            End If
       End If
   ElseIf TypeOf Ent Is AcadMText Or TypeOf Ent Is AcadText Then
        Dim Rot As Double
        Rot = Ent.Rotation
        If N1(Ent) Then
           If Ent.TextString = "" Then
               Ent.Delete
           Else
               ins = Ent.InsertionPoint
               If Not ins(2) = 0 Then
                   If Rot <> 0 Then
                    Ent.InsertionPoint = Z0(ins)
                   End If
               End If
               Ent.Rotation = Rot
           End If
       End If
   ElseIf TypeOf Ent Is AcadLeader Then
       Set oLeader = Ent
       P1 = oLeader.Normal
       If N1(oLeader) Then
           El(2) = oLeader.Coordinate(0)(2)
           oLeader.Move El, Zero
       End If
   ElseIf TypeOf Ent Is Acad3DFace Then
       Set oFace = Ent
       P1 = oFace.Coordinates
       For i = 0 To (UBound(P1) - 2) / 3
           P2 = oFace.Coordinate(i)
           P2(2) = 0
           oFace.Coordinate(i) = P2
       Next
   ElseIf TypeOf Ent Is AcadDimension Then

   'DimPointsToZero Ent
   End If



End Sub

Function Z0(P1 As Variant) As Variant
    P1(2) = 0
    Z0 = P1
End Function


Function N1(Ent As AcadEntity) As Boolean

    Dim N As Variant, Norm(2) As Double
    Dim oSpace As AcadBlock
    Dim oarc As AcadArc
    Dim newArc As AcadArc
    Dim newEll As AcadEllipse
    Dim oEll As AcadEllipse
    Dim oReg As AcadRegion
    Dim P1, P2
    Dim Sr As Double, Er As Double
    On Error GoTo Err_Control
    Norm(2) = 1
    N = Ent.Normal
    If Rd(N(0), 0) Then
        If Rd(N(1), 0) Then
            If Rd(N(2), 1) Then
                N1 = True
                If TypeOf Ent Is AcadRegion Or _
                       TypeOf Ent Is AcadLeader Then
                Else
                    Ent.Normal = Norm
                End If
            ElseIf Rd(N(2), -1) Then
                If TypeOf Ent Is AcadCircle Then
                    Ent.Normal = Norm
                    N1 = True
                ElseIf TypeOf Ent Is AcadArc Then
                    Set oarc = Ent
                    P1 = oarc.center
                    P1(2) = 0
                    Sr = Pi - oarc.endAngle
                    Er = Pi - oarc.startAngle
                    Set oSpace = ThisDrawing.ObjectIdToObject(Ent.OwnerID)
                    Set newArc = oSpace.AddArc(P1, oarc.radius, Sr, Er)
                    newArc.Layer = oarc.Layer
                    newArc.LineType = oarc.LineType
                    newArc.LinetypeScale = oarc.LinetypeScale
                    oarc.Delete
                 ElseIf TypeOf Ent Is AcadEllipse Then
                    Set oEll = Ent
                    P1 = oEll.center
                    P1(2) = 0
                    Sr = (2 * Pi) - oEll.endAngle
                    Er = (2 * Pi) - oEll.startAngle
                   
                    Set oSpace = ThisDrawing.ObjectIdToObject(Ent.OwnerID)
                    P2 = oEll.MajorAxis
                    P2(2) = 0
                    Set newEll = oSpace.AddEllipse(P1, P2, oEll.RadiusRatio)
                    With newEll
                        .startAngle = Sr
                        .endAngle = Er
                        .Layer = oEll.Layer
                        .LineType = oEll.LineType
                        .LinetypeScale = oEll.LinetypeScale
                        .TrueColor = oEll.TrueColor
                    End With
                    oEll.Delete
                ElseIf TypeOf Ent Is AcadRegion Then
                    Set oReg = Ent
                    MoveByBB oReg
                ElseIf TypeOf Ent Is AcadLeader Then
                    MoveByBB Ent
                ElseIf TypeOf Ent Is AcadBlockReference Then
                    Dim NegNorm(2) As Double
                    NegNorm(2) = -1
                    Ent.Normal = NegNorm
                    MoveByBB Ent
                   
                End If
               
            End If
        End If
    End If
Exit_Here:
    Exit Function
Err_Control:
    Select Case Err.Number
        Case -2145386371   'General modeling failure
        Debug.Print oEll.ObjectID
        Case Else
        'MsgBox Err.Description
        Debug.Print Err.Number, Err.Description
        Err.Clear
        Resume Exit_Here
    End Select
End Function



Function isN(oarc As AcadArc) As Boolean
    Dim N As Variant
    Dim NewN(2) As Double
    N = oarc.Normal
    If Abs(N(0)) < 0.0001 Then
        If Abs(N(1)) < 0.0001 Then
            If N(2) > 0.9999 And Abs(N(2)) < 1.0001 Then
                isN = True
                NewN(2) = 1
                oarc.Normal = NewN
                Exit Function
            ElseIf N(2) < -0.9999 And Abs(N(2)) > -1.0001 Then
                isN = True
                NewN(2) = -1
                oarc.Normal = NewN
                Exit Function
            End If
        End If
    End If
End Function

Function MoveByBB(Ent As AcadEntity)
    Dim Min, Max
    Ent.GetBoundingBox Min, Max
    If Rd(Min(2), Max(2)) Then
        Max = Min
        Max(2) = 0
        Ent.Move Min, Max
    End If

End Function




Fatty

  • Guest
Re: Reverse the normal of an arc??
« Reply #2 on: August 04, 2006, 07:12:11 AM »
Does anyone have some code that they can share that will reverse the normal of an arc to 0,0,1, if the original arc is 0,0,-1?

Thanks,

Dave
Hi Dave
Maybe this will help for you
Code: [Select]
Sub PutArcNormal()

Dim oArc As AcadEntity
Dim pickPnt As Variant
Dim norVec As Variant
Dim vecStr As String
ThisDrawing.Utility.GetEntity oArc, pickPnt, vbCr & "Select arc"

If TypeOf oArc Is AcadArc Then
norVec = oArc.Normal
   vecStr = Replace(CStr(norVec(0)), ",", ".") & "," & _
            Replace(CStr(norVec(1)), ",", ".") & "," & _
            Replace(CStr(norVec(2)), ",", ".")
MsgBox "Current normal is: " & vecStr
norVec(0) = 0#: norVec(1) = 0#: norVec(2) = 1#:
oArc.Normal = norVec
oArc.Update
   vecStr = Replace(CStr(norVec(0)), ",", ".") & "," & _
            Replace(CStr(norVec(1)), ",", ".") & "," & _
            Replace(CStr(norVec(2)), ",", ".")
MsgBox "Normal changed to: " & vecStr
Else
MsgBox "This is not an arc"
Exit Sub
End If

End Sub

(I think for region this property is read only mode)

Fatty

~'J'~

DaveW

  • Guest
Re: Reverse the normal of an arc??
« Reply #3 on: August 04, 2006, 07:27:07 AM »
Thanks guys.

I will give it a shot in few hours.

Dave

DaveW

  • Guest
Re: Reverse the normal of an arc??
« Reply #4 on: August 04, 2006, 10:05:08 AM »
Bryco,

I could not get you code to work. It seemed to run through when I changed Rd to round, but I had to remove the -1 line too. The arc remained unchanged.


Fatty,

I was able to accomplish the same thing. The arc will move and roate when you do this. I want to keep it looking and positioned exactly as the original arc.


Thanks

DaveW

  • Guest
Re: Reverse the normal of an arc??
« Reply #5 on: August 04, 2006, 11:30:38 AM »
This seems to work.

Code: [Select]
Sub ReverseArcNormal()
   
Dim oArc As AcadArc
Dim ent As AcadEntity
Dim STPoint(0 To 2) As Double
Dim ENPoint(0 To 2) As Double
Dim rotateAngle As Double
Dim midpoint(0 To 2) As Double

rotateAngle = 180
rotateAngle = rotateAngle * 3.14159265358979 / 180#
   
For Each ent In thisdrawing.ModelSpace
   
  If TypeOf ent Is AcadArc Then
       Set oArc = ent
            
       STPoint(0) = oArc.StartPoint(0)
       STPoint(1) = oArc.StartPoint(1)
       STPoint(2) = oArc.StartPoint(2)
       
       ENPoint(0) = oArc.EndPoint(0)
       ENPoint(1) = oArc.EndPoint(1)
       ENPoint(2) = oArc.EndPoint(2)
           
       oArc.Rotate3D STPoint, ENPoint, rotateAngle

       midpoint(0) = (STPoint(0) + ENPoint(0)) / 2
       midpoint(1) = (STPoint(1) + ENPoint(1)) / 2
       midpoint(2) = (STPoint(2) + ENPoint(2)) / 2
       
       oArc.Rotate midpoint, rotateAngle
 
   End If
           
Next
End Sub



For a region that does not have splines you will need to explode the region, set the lines and arcs normals (2) to 1 and them join it back into a polyline and then create a region from the polyline.

I do that quite a bit in my code so it is no issue. If anyone needs something for that let me know.

« Last Edit: August 04, 2006, 12:14:50 PM by DaveW »

Fatty

  • Guest
Re: Reverse the normal of an arc??
« Reply #6 on: August 04, 2006, 01:25:06 PM »
Hey, Dave
Good point
Works like a charm

~'J'~

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Reverse the normal of an arc??
« Reply #7 on: August 04, 2006, 05:24:49 PM »
Good solution Dave, I'm gonna use that.
Just saw your other post
Code: [Select]
Sub d()
Dim ent As AcadEntity, v
ThisDrawing.Utility.GetEntity ent, v
FlattenThis ent
End Sub
Function Rd(num1 As Variant, num2 As Variant) As Boolean
    Dim dRet As Double
    dRet = num1 - num2
    If Abs(dRet) < 0.00000001 Then Rd = True
End Function
This works for me but I'm still changing to yours.
« Last Edit: August 04, 2006, 05:32:40 PM by Bryco »