Move all blocks

[jplujan]

Hello

I'm trying to make a macro blocks outplacement
All blocks have a nested block named "Connection1".

I get the point of insertion of the "Connection1" block but with respect to the main block is not with respect to the drawing.

I leave codes and a drawing if anyone can help me

Thanks in advance

    Private Sub btnRecoloca_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRecoloca.Click
        Dim pto(2) As Double
        pto = oACAD.Conexion

        Dim pto1(2) As Double
        pto1 = oACAD.Conexion

        oACAD.MoverBloque("PRIMARIO ACS", pto1(0), pto1(1), pto(0), pto(1))

    End Sub

 Function Conexion() As Object

        Dim oBloquePrincipal As Object
        Dim oBloqueSeleccion As Object = Nothing
        Dim oBloqueHijo As Object
        Dim oBlkDefOut As AcadBlock
        Dim Identificador As String
        Identificador = "CONEXION1"

        oApp.ActiveDocument.Utility.GetEntity(oBloqueSeleccion, "Select object:")

        For Each oBloquePrincipal In oApp.ActiveDocument.Blocks
            If oBloquePrincipal.name = oBloqueSeleccion.name Then
                oBlkDefOut = oBloquePrincipal
                For Each oBloqueHijo In oBlkDefOut
                    If TypeName(oBloqueHijo) = "IAcadBlockReference" Then
                        If oBloqueHijo.EffectiveName = Identificador Then
                            Return (oBloqueHijo.INSERTIONPOINT)

                        End If
                    End If

                Next oBloqueHijo
            End If
        Next oBloquePrincipal

        regenera()


    End Function






Sub MoverBloque(ByVal strNombreBloque As String, ByVal point1x As Double, ByVal point1y As Double, ByVal point2x As Double, ByVal point2y As Double)
        Dim oblockRef As AcadBlockReference
        Dim oEnt As AcadEntity

        Dim ptoInicio(2) As Double
        Dim PtoFinal(2) As Double
        
        ptoInicio(0) = point1x
        ptoInicio(1) = point1y
        ptoInicio(2) = 0

        PtoFinal(0) = point2x
        PtoFinal(1) = point2y
        PtoFinal(2) = 0

        For Each oEnt In oApp.ActiveDocument.ModelSpace
            If TypeOf oEnt Is AcadBlockReference Then
                oblockRef = oEnt
                If oblockRef.EffectiveName = strNombreBloque Then
                    oblockRef.Move(ptoInicio, PtoFinal)
                End If
            End If
           
        Next
    End Sub

[jplujan]

Sorry attached new drawing as it should be

[_gile]

Hi,

If you want to move a nested bloc within its "parent", you have to move the block reference within the block definition, then a regen will update all inserted "parent" references

[jplujan]

Sorry but I think not explained.
I want to move the parent block having as reference the insertion point of a child block.
The child in this case block have been a way to find a reference for movement

thanks

[_gile]

Sorry,

If I don't misunderstand, what you attempt to do is moving PRIMARIO ACS block reference so that the nested CONEXION1 in PRIMARIO ACS overlaps the nested CONEXION1 in BPC-1-CAL.

If so, the Conexion function, instead of returning the insertion point of CONEXION within its parent definition, have to return the parent reference insertion point minus the insertion point of CONEXION within its parent definition as vector.

[Anonymous]

---

@jplujan wrote:

I get the point of insertion of the "Connection1" block but with respect to the main block is not with respect to the drawing.

Sure thing, you get the 'Connection1' position browsing the parent block definition, thus you get a relative position. But you just need to add the position of the BlockReference you have selected by hand. It's what you called oBloqueSelection, from which you got the name you used to find the block definition... just add its location to the relative position and you get the point you need.

Bytheway, I'm not fond of VB, but since you selected a blockreference, the blockdefinition should be just a property of BlockReference, there is no need to traverse the Blocktable list to find it by name...

[_gile · Accepted solution]

As I said upper I'm not comfortable with VBA like coding, so the following attempt may not work as is (not tested) but I think it shows the way.

 Function Conexion() As Object

        Dim oBloquePrincipal As Object
        Dim oBloqueSeleccion As Object = Nothing
        Dim oBloqueHijo As Object
        Dim oBlkDefOut As AcadBlock
        Dim Identificador As String
        Identificador = "CONEXION1"

        oApp.ActiveDocument.Utility.GetEntity(oBloqueSeleccion, "Select object:")
		
		oBlkDefOut = oApp.ActiveDocument.Blocks.Item(oBloqueSeleccion.name)
		For Each oBloqueHijo In oBlkDefOut
			If TypeName(oBloqueHijo) = "IAcadBlockReference" Then
				If oBloqueHijo.EffectiveName = Identificador Then
					Dim returnValue(2) As Double
					returnValue(0) = oBloqueHijo.InsertionPoint(0) + oBloqueSeleccion.InsertionPoint(0)
					returnValue(1) = oBloqueHijo.InsertionPoint(1) + oBloqueSeleccion.InsertionPoint(1)
					returnValue(2) = oBloqueHijo.InsertionPoint(2) + oBloqueSeleccion.InsertionPoint(2)
					Return returnValue

				End If
			End If

		Next oBloqueHijo

        regenera()


    End Function

[_gile]

Here's a working solution using the .NET API.

It requires to reference the AutoCAD .NET libraries (AcCoreMgd.dll, AcDbMgd.dll and AcMgd.dll) and to import the related namespaces (Autodesk.AutoCAD.ApplicationServices, Autodesk.AutoCAD.DatabaseServices, Autodesk.AutoCAD.EditorInputs, Autodesk.AutoCAD.Geometry and Autodesk.AutoCAD.Runtime).

        Private Sub btnRecoloca_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRecoloca.Click
            Using tr As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction
                Dim pt1 As System.Nullable(Of Point3d) = Conexion()
                If pt1 Is Nothing Then
                    Return
                End If
                Dim pt2 As System.Nullable(Of Point3d) = Conexion()
                If pt2 Is Nothing Then
                    Return
                End If
                MoverBloque("PRIMARIO ACS", pt1.Value, pt2.Value)
                tr.Commit()
            End Using
        End Sub

        Private Function Conexion() As System.Nullable(Of Point3d)
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim options As PromptEntityOptions = New PromptEntityOptions(vbLf & "Select block: ")
            options.SetRejectMessage("Must be a block.")
            options.AddAllowedClass(GetType(BlockReference), True)
            Dim result As PromptEntityResult = ed.GetEntity(options)
            If result.Status = PromptStatus.OK Then
                Dim br As BlockReference = DirectCast(result.ObjectId.GetObject(OpenMode.ForRead), BlockReference)
                Dim btr As BlockTableRecord = DirectCast(br.BlockTableRecord.GetObject(OpenMode.ForRead), BlockTableRecord)
                For Each id As ObjectId In btr
                    If id.ObjectClass.DxfName = "INSERT" Then
                        Dim nested As BlockReference = DirectCast(id.GetObject(OpenMode.ForRead), BlockReference)
                        If nested.Name = "CONEXION1" Then
                            Return nested.Position.TransformBy(br.BlockTransform)
                        End If
                    End If
                Next
            End If
            Return Nothing
        End Function

        Private Sub MoverBloque(nombreBloque As String, point1 As Point3d, point2 As Point3d)
            Dim disp = Matrix3d.Displacement(point1.GetVectorTo(point2))
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Dim bt As BlockTable = DirectCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
            If Not bt.Has(nombreBloque) Then
                Return
            End If
            Dim modelSpaceId As ObjectId = SymbolUtilityServices.GetBlockModelSpaceId(db)

            Dim moveRefs As Action(Of BlockTableRecord) =
                Sub(def)
                    For Each id As ObjectId In def.GetBlockReferenceIds(True, False)
                        Dim br = DirectCast(id.GetObject(OpenMode.ForWrite), BlockReference)
                        If br.OwnerId = modelSpaceId Then
                            br.TransformBy(disp)
                        End If
                    Next
                End Sub

            Dim btr As BlockTableRecord = DirectCast(bt(nombreBloque).GetObject(OpenMode.ForRead), BlockTableRecord)
            moveRefs(btr)
            For Each anonId As ObjectId In btr.GetAnonymousBlockIds()
                Dim anonBtr As BlockTableRecord = DirectCast(anonId.GetObject(OpenMode.ForRead), BlockTableRecord)
                moveRefs(anonBtr)
            Next
        End Sub

[jplujan]

Forgiveness and thank you all for responding, but I could not see the answers until today.

Thank you

[jplujan]

Muchas gracias por vuestra ayuda _gile y mcicogmani he estado probando la opcion vba ya que todo el codigo del proyecto es una solucion vb.net exe y funciona.

Gracias nuevamente.

[jplujan · Accepted solution]

Sorry'm from Spain and I forgot to do the translation

Thank you very much for your help and mcicogmani _gile have been testing the option vba because all code project is a solution vb.net exe and it works.

Thanks again.