1. Login to Give a bone

## Find Polygon Diagonals

I need to draw the diagonals in a collection of many 4-sided closed polylines. The polylines could be any mix of polyline types: lightweight, heavyweight etc. The obvious solution is to get the xyz coords of the 4 vertices and draw a line from v1 to v3 and v2 to v4.

I got it to work in 2d when z=0. However, the polygons are mostly in 3D, flipped and dipped and facing everywhich way. Even so, polyline.coordinates only returns the xy coords. Determining the z coord apparently requires some sort of calculation. Ironically, a simple list command will return exactly what I need:

Code:
```
LWPOLYLINE Layer: "Diagrid"
Space: Model space
Handle = 59
Closed
Constant width 0.00000000
Extrusion direction relative to UCS:
X=-0.34529029 Y=-0.36162773 Z=0.86602540
area 16936.19977269
perimeter 520.69569424
at point X=-13.85050859 Y=647.56652579 Z=0.00000000
at point X=110.82245818 Y=638.65452535 Z=45.98657127
at point X=119.33183683 Y=520.40102410 Z=0.00000000
at point X=-5.34112994 Y=529.31302453 Z=-45.98657127```
Is there a simple way to get the xy AND z of any polyline vertex?

The layer name gives away what the application is about.

2. Login to Give a bone

## Re: Find Polygon Diagonals

The Key is "Extrusion direction relative to UCS"... LWPOLYLINES are 2D, yours was created in a different UCS than you were in when you listed it.

Thinking out loud here....

What if you set the UCS = the object, then grabbed the four corners, then used the (inters) function to find the center.

You could probably use the (trans) function also without having to switch the UCS, but I would have to explore that a bit....

3. Login to Give a bone

## Re: Find Polygon Diagonals

I admit UCS is a VBA topic I don't entirely understand. But I think you're onto something here. I manually set the UCS to the polyline object. The results are below.

Code:
```
LWPOLYLINE  Layer: "Diagrid"
Space: Model space
Handle = 2c
Closed
Constant width  0.000000
area   16936.199773
perimeter   520.695694
at point  X= 0.000000  Y= 0.000000  Z= 0.000000
at point  X= 0.000000  Y=133.182345  Z= 0.000000
at point  X=127.165502  Y=133.182345  Z= 0.000000
at point  X=127.165502  Y= 0.000000  Z= 0.000000```
The z coords are now all zero, so 2D VBA polyline.coordinates will probably now work the way I want it to.

Trouble is, I can't find a VBA method that will set the UCS to an individual object. (at least a method I understand)

4. Login to Give a bone

## Re: Find Polygon Diagonals

Originally Posted by MikeJarosz
...I can't find a VBA method
And here I was giving you LISP functions to run. Sorry about that, I didn't pay attention that this was the VBA group or that you were using VBA. I was just thinking about the problem....

5. Login to Give a bone

## Re: Find Polygon Diagonals

I solved it by avoiding the UCS/OCA issue. In a nutshell, I exploded the polyline, grabbed the startpoint xyz of each resultant line then restored the polyline with sendcommand "undo". The lines can then be drawn from V1 to V3 and V2 to v4.

An orbit view looks great!

6. Login to Give a bone

## Re: Find Polygon Diagonals

I would like to try solving the polygon diagonals problem without resorting to the explode method. The polygon is rotated in space and has all different z coordinates. After much searching, I still cannot find a way to isolate the actual xyz coordinates of the 4 vertices from VBA methods. The coordinates property returns only 8 items for a 4 sided poly; the z is ignored. Not only that, but the x and y are projections, not the actual xy values of the vertex.

What appears to be a likely solution is to change the coordinate system to be parallel to the face of the polygon. This forces the z values to be zero, and the xy coordinates found using the coordinates method. I then have the points I need to draw the diagonals. Mind you, I still don't have the true WCS coords of the vertices. I have to transform back to world and use the startpoints of the lines for that.

I can use the tools --> new UCS --> object menu in Acad to create a UCS parallel to the poly face. Trouble is I have 30,000 polylines. Doing each poly interactively is unreasonable. So I have to go into VBA. I can find no easy way to emulate the tools --> new UCS --> object technique.
This leads to the VBA translate coordinates method. VBA help gives the following example of setting the UCS:

Code:
```
' Create a UCS named "New_UCS" in current drawing
Dim origin(0 To 2) As Double
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double

' Define the UCS
origin(0) = 2#: origin(1) = 2#: origin(2) = 2#
xAxisPnt(0) = 5#: xAxisPnt(1) = 2#: xAxisPnt(2) = 2#
yAxisPnt(0) = 2#: yAxisPnt(1) = 6#: yAxisPnt(2) = 2#

' Add the UCS to the UserCoordinatesSystems collection
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
ThisDrawing.ActiveUCS = ucsObj```
I don't seem to be able to get past this example. The x and y axis points appear to be the same as the origin point except for xpt(0) and ypt(1). How do I relate this to my polyline? What are the xaxispt =5# and the yaxispt = 6#? These numbers look arbitrary to me.

These are my polyline coords in WCS. Notice the z values:

Code:
```
LWPOLYLINE  Layer: "Diagrid"
Space: Model space
Handle = 2d
Closed
Constant width  0.000000
Extrusion direction relative to UCS:
X=-0.345290  Y=-0.361628  Z= 0.866025
area   16936.199773
perimeter   520.695694
at point  X=-6.925254  Y=323.783263  Z= 0.000000
at point  X=117.747712  Y=314.871262  Z=45.986571
at point  X=126.257091  Y=196.617761  Z= 0.000000
at point  X= 1.584124  Y=205.529762  Z=-45.986571```
If I could grab these numbers in VBA, I'd be done.

If I do tools --> new UCS --> object I get:

Code:
```
LWPOLYLINE  Layer: "Diagrid"
Space: Model space
Handle = 2d
Closed
Constant width  0.000000
area   16936.199773
perimeter   520.695694
at point  X= 0.000000  Y=127.165502  Z= 0.000000
at point  X=133.182345  Y=127.165502  Z= 0.000000
at point  X=133.182345  Y= 0.000000  Z= 0.000000
at point  X= 0.000000  Y= 0.000000  Z= 0.000000```
Both of these data sets give me the info I need to draw my lines, but they come from the list window, not VBA. Why can list do it, and VBA not?

I tried the ADN help line. The answer I got is that I should use the coordinates and translate coordinates methods. I knew that already. No help was offered on understanding how these methods work as applied to an actual object like a polyline.

I tried plugging different combinations of my numbers into their code. Nothing I did could create a UCS that was parallel to the poly face.

What am I missing? Can someone show me how to create a parallel UCS to the poly.dwg I have attached?

7. Login to Give a bone

## Re: Find Polygon Diagonals

I had to create a very similar routine a while back though I only had to deal with LWPoly's. 2DPoly's add a little more complexity, especially if there is a need to isolate those with only four sides.

In any event, the pertinent section of the code is below. It seems pretty stable but add whatever error checking deemed neccessary. Hope it helps.

I'm glad I previewed . . . . the smiley faces represent (eight)

Option Explicit
Sub DrawDiagonal()
Dim intCode( As Integer
Dim varData( As Variant
Dim dblStPt(2) As Double
Dim dblNdPt(2) As Double
Dim varCoords As Variant
Dim varStPt As Variant
Dim varNdPt As Variant
Dim dblElev As Double
Dim varNormal As Variant
Dim i As Integer, j As Integer
With ThisDrawing
intCode(0) = 0: varData(0) = "LWPOLYLINE"
intCode(1) = -4: varData(1) = "&="
intCode(2) = 70: varData(2) = 1
intCode(3) = -4: varData(3) = "&"
intCode(4) = 70: varData(4) = 129
intCode(5) = 90: varData(5) = 4
intCode(6) = -4: varData(6) = "<Not"
intCode(7) = 67: varData(7) = 1
intCode( = -4: varData( = "Not>"
If SSAll(intCode, varData) <> 0 Then
For Each entLWPL In .SelectionSets("TempSSet")
dblElev = entLWPL.Elevation
varNormal = entLWPL.Normal
varCoords = entLWPL.Coordinates
For i = 0 To 1
For j = 0 To 1
dblStPt(j) = varCoords(j + (2 * i))
dblNdPt(j) = varCoords(j + 4 + (2 * i))
Next
dblStPt(2) = dblElev
dblNdPt(2) = dblElev
varStPt = dblStPt
varStPt = .Utility.TranslateCoordinates(varStPt, acOCS, acWorld, 0, varNormal)
varNdPt = dblNdPt
varNdPt = .Utility.TranslateCoordinates(varNdPt, acOCS, acWorld, 0, varNormal)
Next
Next
End If
End With
End Sub

Function SSAll(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
'get selection set
If IsMissing(grpCode) Then
TempObjSS.Select acSelectionSetAll
Else
TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
End If
SSAll = TempObjSS.Count
End Function

'choose a selection set name for temporary storage and
'ensure that it does not currently exist
On Error Resume Next
Set SSS = ThisDrawing.SelectionSets
If SSS.Count > 0 Then
SSS.Item("TempSSet").Delete
End If
End Sub

8. Login to Give a bone

## Re: Find Polygon Diagonals

Code tags should help with a Copy and Paste. I'm still trying to sort out all these posting details.

Code:
```Option Explicit
Sub DrawDiagonal()
Dim intCode(8) As Integer
Dim varData(8) As Variant
Dim dblStPt(2) As Double
Dim dblNdPt(2) As Double
Dim varCoords As Variant
Dim varStPt As Variant
Dim varNdPt As Variant
Dim dblElev As Double
Dim varNormal As Variant
Dim i As Integer, j As Integer
With ThisDrawing
intCode(0) = 0: varData(0) = "LWPOLYLINE"
intCode(1) = -4: varData(1) = "&="
intCode(2) = 70: varData(2) = 1
intCode(3) = -4: varData(3) = "&"
intCode(4) = 70: varData(4) = 129
intCode(5) = 90: varData(5) = 4
intCode(6) = -4: varData(6) = "<Not"
intCode(7) = 67: varData(7) = 1
intCode(8) = -4: varData(8) = "Not>"
If SSAll(intCode, varData) <> 0 Then
For Each entLWPL In .SelectionSets("TempSSet")
dblElev = entLWPL.Elevation
varNormal = entLWPL.Normal
varCoords = entLWPL.Coordinates
For i = 0 To 1
For j = 0 To 1
dblStPt(j) = varCoords(j + (2 * i))
dblNdPt(j) = varCoords(j + 4 + (2 * i))
Next
dblStPt(2) = dblElev
dblNdPt(2) = dblElev
varStPt = dblStPt
varStPt = .Utility.TranslateCoordinates(varStPt, acOCS, acWorld, 0, varNormal)
varNdPt = dblNdPt
varNdPt = .Utility.TranslateCoordinates(varNdPt, acOCS, acWorld, 0, varNormal)
Next
Next
End If
End With
End Sub

Function SSAll(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
'get selection set
If IsMissing(grpCode) Then
TempObjSS.Select acSelectionSetAll
Else
TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
End If
SSAll = TempObjSS.Count
End Function
'choose a selection set name for temporary storage and
'ensure that it does not currently exist
On Error Resume Next
Set SSS = ThisDrawing.SelectionSets
If SSS.Count > 0 Then
SSS.Item("TempSSet").Delete
End If
End Sub```

9. Login to Give a bone

## Re: Find Polygon Diagonals

Thanks Sean, it worked perfectly.

I'm working hard to figure it out. You might be able to guess from my posting that I don't quite get the translate coordinates method.

10. Login to Give a bone

## Re: Find Polygon Diagonals

Originally Posted by seant61
Code tags should help with a Copy and Paste. I'm still trying to sort out all these posting details.
To get rid of the smilies, while in the advanced editor, check "Disable smilies in text".

Page 1 of 2 12 Last

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•