Set Z = 0 for 3dpoly in selection set relative to UCS. Trying Utility.TranslateCoordinates

[CadWCCNL]

Hi,

I am trying to achieve the same results "FLATTEN" (No Removed Hidden Lines) would have when used in an Active UCS. Or in other words, Flatten a 3dpolyline relative to the Active UCS.

I thought this was as simple as setting all vertices in a 3d poly to 0, relative to UCS. I was horrible wrong. I have the coordinates of the 3d poly and can iterate through to replace the z value for all the vertices to 0 but it is strictly to the WCS since that is what VBA operates with.

I thought Utility.TranslateCoordinates() looked like a reasonable solution to my problem but I am either implementing it wrong or what I expect it to do isn't what it does because it isn't returning the value I am expecting.

    Dim viewportObj As AcadViewport
    Set viewportObj = ThisDrawing.ActiveViewport
    viewportObj.UCSIconOn = True
    viewportObj.UCSIconAtOrigin = True
    ThisDrawing.ActiveViewport = viewportObj
    
    ''Translate a point
    Dim center(0 To 2) As Double
    center(0) = 0
    center(1) = 0
    center(2) = 0
    Dim pointUCS As Variant
    pointUCS = ThisDrawing.Utility.TranslateCoordinates(center, acWorld, acUCS, True)
    ''Debug
    Debug.Print "( " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2) & ")"
    
    Dim arr() As Double
    ReDim arr(nu) As Double
    
    ar = polylineA.Coordinates
        For i = 0 To nu
            arr(i) = ar(i)
        Next i
        For i = 2 To nu Step 3
            arr(i) = pointUCS(2)
        Next i
    polylineA.Coordinates = arr

No matter how I flip about the World vs UCS vs True/False (for Displacement cause who knows). None of them quite do what I am looking for. Sometimes the poly is at WCS 0, sometimes it is at elevation of UCS (but no slope or gradient etc, which should be inherently baked into the UCS no?)

Edit: I think I oversimplified. I need the WCS of the vertex, translate to UCS, edit Z value to 0, translate to WCS, and finally update polyline vertex. How in the world do I do that in VBA? Not sure if I am implementing this step utility correctly or is if there is a better approach..

Edit2: Implemented what I believe to be a temporary fix but TranslateCoordinates does not return an array? Stuck on Type mismatching 😕

    ar = polylineA.Coordinates
    Dim arr() As Double
    ReDim arr(UBound(ar)) As Double
    Dim Transformarra(2) As Double
    Dim Transformarrb(2) As Double
    
    For i = 0 To UBound(ar) Step 3
        arr(i) = ar(i) = Transformarra(0)
        arr(i + 1) = ar(i + 1) = Transformarra(1)
        arr(i + 2) = ar(i + 2) = Transformarra(2)
        Transformarra = ThisDrawing.Utility.TranslateCoordinates(arr, acWorld, acUCS, False)
        Transformarra(2) = 0#
        Transformarrb = ThisDrawing.Utility.TranslateCoordinates(Transformarra, acUCS, acWorld, False)
        arr = Transformarrb
    Next i
    polylineA.Coordinates = arr

Any suggestions or direction would be greatly appreciated. If you need any additional information please let me know!

David

[CadWCCNL · Accepted solution]

Hi all,

After taking a step away from the problem and coming back, I realized I was unpacking and rebuilding the array in a problematic way. Have had the best success with a sliding window iterator to unpack the array, process the coordinates, and re-add them in sets of 3 into a new array. Then set the old polyline.Coordinates = newcords.