Union of two Regions

[Anonymous]

Dear All,

How do I do a boolean Union of two co-planar regions with AutoCAD VBA? (see regionobjrev and regionobjrev2 created with the example code below)

TIA

Bernardo Botelho

'Creates two diferent regionsN
Sub TesteRegion()
    Dim plineObj As AcadLWPolyline
    Dim plineObj2 As AcadLWPolyline
  
    Dim points(0 To 9) As Double
        points(0) = 0: points(1) = 0
        points(2) = -5: points(3) = 0
        points(4) = -5: points(5) = -3
        points(6) = -8: points(7) = -9
        points(8) = 0: points(9) = 0
  
        Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  
    Dim Explodeobjrev As Variant
        Explodeobjrev = plineObj.Explode
    Dim regionobjrev As Variant
        regionobjrev = ThisDrawing.ModelSpace.AddRegion(Explodeobjrev)
      
    Dim points2(0 To 9) As Double
        points2(0) = -1: points2(1) = -1
        points2(2) = 5: points2(3) = 0
        points2(4) = 5: points2(5) = 3
        points2(6) = 8: points2(7) = 9
        points2(8) = -1: points2(9) = -1
  
        Set plineObj2 = ThisDrawing.ModelSpace.AddLightWeightPolyline(points2)
  
    Dim Explodeobjrev2 As Variant
        Explodeobjrev2 = plineObj2.Explode
    Dim regionobjrev2 As Variant
        regionobjrev2 = ThisDrawing.ModelSpace.AddRegion(Explodeobjrev2)
      
End Sub

[Alfred.NESWADBA]

Hi,

add this line as the last line before "End Sub":

      Call regionobjrev(0).Boolean(acUnion, regionobjrev2(0))

- alfred -

[Anonymous]

Alfred,

Thank you very much for your quick reply, that worked very well.

(As you problably noticed, I´m a VBA newbie.)

Best Regards

Bernardo

[Anonymous]

Dear Alfred,

Now I´m stuck with the problem of editing the region I created (change simbology, move, delete, etc)

How do I identify that region in VBA?

Thanks,

Bernardo

[Hallex]

If this actual for you, see if the following addition is working for you:

Option Explicit 


'Creates two diferent regions 



Sub TesteRegion()



    Dim plineObj As AcadLWPolyline 


    Dim plineObj2 As AcadLWPolyline


  Dim i As Integer 


    Dim points(0 To 9) As Double


        points(0) = 0: points(1) = 0


        points(2) = -5: points(3) = 0


        points(4) = -5: points(5) = -3


        points(6) = -8: points(7) = -9


        points(8) = 0: points(9) = 0

  
        Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

  
    Dim Explodeobjrev As Variant


        Explodeobjrev = plineObj.Explode


    Dim regionobjrev As Variant


        regionobjrev = ThisDrawing.ModelSpace.AddRegion(Explodeobjrev)

      
    Dim points2(0 To 9) As Double


        points2(0) = -1: points2(1) = -1


        points2(2) = 5: points2(3) = 0


        points2(4) = 5: points2(5) = 3


        points2(6) = 8: points2(7) = 9


        points2(8) = -1: points2(9) = -1

  
        Set plineObj2 = ThisDrawing.ModelSpace.AddLightWeightPolyline(points2)

  
    Dim Explodeobjrev2 As Variant


          Explodeobjrev2 = plineObj2.Explode


    Dim regionobjrev2 As Variant


          regionobjrev2 = ThisDrawing.ModelSpace.AddRegion(Explodeobjrev2)


       'regionobjrev(0) would be as result of boolean operation:


       regionobjrev(0).Boolean acUnion, regionobjrev2(0)


       'if you want just rich at common properties then cast an entity from variant:


       Dim ent As AcadEntity


          Set ent = regionobjrev(0)


           ent.color = acCyan


      'to get/put region's properties you have to cast Region from entity (or from variant same as above)


      Dim reg As AcadRegion


         Set reg = ent


         'dispaly info if it's needs


          MsgBox "Area of Region:" & vbCr & Round(reg.Area, 2) & " sq.units" & vbCr & _

          "Centroid of Region:" & vbCr & Round(reg.Centroid(0), 3) & " ; " & Round(reg.Centroid(1), 3), vbInformation

     
      Dim expEnt As AcadEntity

      
      For i = 0 To UBound(Explodeobjrev2)


          Set expEnt = Explodeobjrev2(i)


            expEnt.Delete


                Next

                
      For i = 0 To UBound(Explodeobjrev)


         Set expEnt = Explodeobjrev(i)


           expEnt.Delete


             Next


      plineObj2.Delete

      
  plineObj.Delete

  
End Sub