making a 'non-parallel to ucs' object parallel

[KevinBarnett]

Greetings Gang,

The time has come for me to solve the "The object is not parallel to the UCS." problem that occurs when the objects normal is not equal to the WCS. We will be assuming that the object is actually drawn on the WCS plane but.. for some wierd reason it's normal is "out-of-sync".

I have started with polylines. The following function translates the co-ordinates from the object coord sys to the WCS and changes the poyline normal to "normal" normal (0,0,1). This means that I will need to write different code for different types of objects. I think I am doing this wrong. Isnt there some method that could be applied to any object - or am I starting to walk down the only available alley?

Thx. Kevin.


Sub OCS2WCS()

Dim NPoint As Variant
Dim Pnt As Variant
Dim Ent1 As AcadEntity
Dim LWPoly1 As AcadLWPolyline
Dim Poly1 As AcadPolyline
Dim Coords As Variant
Dim Int1 As Integer
Dim Lng1 As Long
Dim PNorm As Variant

ThisDrawing.Utility.GetEntity Ent1, Pnt

Select Case Ent1.ObjectName
Case "AcDbPolyline"
Set LWPoly1 = Ent1
Coords = LWPoly1.Coordinates
Int1 = 2
PNorm = LWPoly1.Normal
Case "AcDb2dPolyline"
Set Poly1 = Ent1
Coords = Poly1.Coordinates
Int1 = 3
PNorm = Poly1.Normal
End Select

Dim TPnts() As Double

ReDim TPnts(0 To UBound(Coords))

If PNorm(0) = 0 And PNorm(1) = 0 Then
If PNorm(2) = 1 Then
GoTo WCSPoly1
End If
End If

For Lng1 = 0 To UBound(Coords) Step Int1
Pnt(0) = Coords(Lng1): Pnt(1) = Coords(Lng1 + 1)
If Int1 = 2 Then
Pnt(2) = LWPoly1.Elevation
Else
Pnt(2) = Coords(Lng1 + 2)
End If
NPoint = ThisDrawing.Utility.TranslateCoordinates(Pnt, acOCS, acWorld, _
True, PNorm)
TPnts(Lng1) = NPoint(0): TPnts(Lng1 + 1) = NPoint(1)
If Int1 = 3 Then
TPnts(Lng1 + 2) = NPoint(2)
End If
Next
PNorm(0) = 0: PNorm(1) = 0: PNorm(2) = 1
If Int1 = 2 Then
LWPoly1.Normal = PNorm
LWPoly1.Coordinates = TPnts
LWPoly1.Update
Else
Poly1.Normal = PNorm
Poly1.Coordinates = TPnts
Poly1.Update
End If

WCSPoly1:

End Sub