Page 1 of 2 12 LastLast
Results 1 to 10 of 18

Thread: Find Polygon Diagonals

  1. #1
    AUGI Addict MikeJarosz's Avatar
    Join Date
    2015-10
    Location
    New York NY
    Posts
    1,497
    Login to Give a bone
    0

    Default 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. #2
    Administrator rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,803
    Login to Give a bone
    0

    Default 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....
    R.K. McSwain | CAD Panacea |

  3. #3
    AUGI Addict MikeJarosz's Avatar
    Join Date
    2015-10
    Location
    New York NY
    Posts
    1,497
    Login to Give a bone
    0

    Default 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. #4
    Administrator rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,803
    Login to Give a bone
    0

    Default Re: Find Polygon Diagonals

    Quote 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....
    R.K. McSwain | CAD Panacea |

  5. #5
    AUGI Addict MikeJarosz's Avatar
    Join Date
    2015-10
    Location
    New York NY
    Posts
    1,497
    Login to Give a bone
    0

    Default 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!
    Attached Files Attached Files

  6. #6
    AUGI Addict MikeJarosz's Avatar
    Join Date
    2015-10
    Location
    New York NY
    Posts
    1,497
    Login to Give a bone
    0

    Default 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 ucsObj As AcadUCS
    	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?
    Attached Files Attached Files

  7. #7
    Active Member
    Join Date
    2007-06
    Posts
    97
    Login to Give a bone
    0

    Default 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 entLWPL As AcadLWPolyline
    Dim entLine As AcadLine
    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)
    Set entLine = .ModelSpace.AddLine(varStPt, varNdPt)
    Next
    Next
    End If
    End With
    End Sub


    Function SSAll(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
    Dim TempObjSS As AcadSelectionSet
    ClearSS
    Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
    'get selection set
    If IsMissing(grpCode) Then
    TempObjSS.Select acSelectionSetAll
    Else
    TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
    End If
    SSAll = TempObjSS.Count
    End Function

    Private Sub ClearSS()
    Dim SSS As AcadSelectionSets
    '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. #8
    Active Member
    Join Date
    2007-06
    Posts
    97
    Login to Give a bone
    0

    Default 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 entLWPL As AcadLWPolyline
    Dim entLine As AcadLine
    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)
                Set entLine = .ModelSpace.AddLine(varStPt, varNdPt)
             Next
          Next
       End If
    End With
    End Sub
    
    
    Function SSAll(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
       Dim TempObjSS As AcadSelectionSet
       ClearSS
       Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
             'get selection set
       If IsMissing(grpCode) Then
          TempObjSS.Select acSelectionSetAll
       Else
          TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
       End If
       SSAll = TempObjSS.Count
    End Function
    Private Sub ClearSS()
    Dim SSS As AcadSelectionSets
       '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. #9
    AUGI Addict MikeJarosz's Avatar
    Join Date
    2015-10
    Location
    New York NY
    Posts
    1,497
    Login to Give a bone
    0

    Default 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. #10
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,397
    Login to Give a bone
    0

    Default Re: Find Polygon Diagonals

    Quote 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".
    C:> ED WORKING....

Page 1 of 2 12 LastLast

Similar Threads

  1. Polygon center
    By Wish List System in forum ACA Wish List
    Replies: 2
    Last Post: 2014-07-02, 03:48 AM
  2. Truss diagonals keep moving
    By jeffcook21 in forum Revit Structure - General
    Replies: 0
    Last Post: 2008-10-23, 10:02 PM
  3. Stretch a Polygon/Maintain the Original Area of Polygon
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2007-08-02, 04:39 PM
  4. Parametric Polygon?
    By sbrown in forum Revit Architecture - General
    Replies: 5
    Last Post: 2005-11-16, 02:48 PM
  5. Polygon Callout
    By thalim in forum Revit Architecture - General
    Replies: 1
    Last Post: 2004-10-12, 05:59 PM

Posting Permissions

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