Jump to content

Finding COG of multiple 3D objects


rjtaylor96
 Share

Recommended Posts

Hi there, im pretty new to coding in Visual Basic for autocad, i was wondering if anyone could help me with this code im trying to develop.

 

Pretty much you select a group of 3d solids and the code automatically draws a sphere at the centroid of those objects. So far i have gotten my code to only show the centroid of one of the objects and not the groups centroid i know what part of code is the issue im just not really sure how to solve it

 

Private Sub CommandButton1_Click()
    Me.Hide
    
    Dim R As Double
    Dim OCG As Variant
    Dim objEnt As Object
    Dim objSset As AcadSelectionSet
    Dim objDraw As AcadCircle
    
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    
    On Error Resume Next
       
    FilterType(0) = 0
    FilterData(0) = "3dsolid"
    
    Set objSset = ThisDrawing.SelectionSets.Add("ss")
    Me.Hide

    objSset.SelectOnScreen FilterType, FilterData
    For Each objEnt In objSset                                                  --- this part is the issue as it changes OCG to whatever object it is going through in the loop

    OCG = objEnt.Centroid

    Next

    With ThisDrawing.Utility
    R = 50
    End With
    
    Set objDraw = ThisDrawing.ModelSpace.AddSphere(OCG, R)
    objDraw.Update
    
    MsgBox "X = " & OCG(0) & " Y = " & OCG(1) & " Z = " & OCG(2) & "."                  -- this will eventually be removed, this double checks atm to see if the code is showing the right centroid
    objSset.Delete

 

any help would be appreciated

Link to comment
Share on other sites

Private Sub CommandButton1_Click()
    Me.Hide
    
    Dim R As Double
    Dim OCG As Variant
    Dim objEnt As Object
    Dim objSset As AcadSelectionSet
    Dim objDraw As AcadCircle
    
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    
    On Error Resume Next
       
    FilterType(0) = 0
    FilterData(0) = "3dsolid"
    
    Set objSset = ThisDrawing.SelectionSets.Add("ss")
    Me.Hide

    objSset.SelectOnScreen FilterType, FilterData
    For Each objEnt In objSset                                                  

    OCG = objEnt.Centroid

    Next

    With ThisDrawing.Utility
    R = 50
    End With
    
    Set objDraw = ThisDrawing.ModelSpace.AddSphere(OCG, R)
    objDraw.Update
    
    MsgBox "X = " & OCG(0) & " Y = " & OCG(1) & " Z = " & OCG(2) & "."                  
    objSset.Delete

should of added the code bb codes sorry

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...