Selecting a block to move with vba

[clsnyder]

Hello everyone, Im trying to directly select a block by name so that I can move it from where ever it may be, to where I want it. Moving a block isnt whats giving me an issue as im useing the ThisDrawing.SendCommand "move 0,0". However I cannot seem to get vba to select the block so I can move it.

 

I cant use a window to select it because sometimes the block is over top of other geomatry or text and I dont want to move that. And the block isnt always in the same spot so I cant select it by insertion point. Hopefully this made sense.

 

Thank you in advance

 

 

cal-

[fixo]

Hello everyone, Im trying to directly select a block by name so that I can move it from where ever it may be, to where I want it. Moving a block isnt whats giving me an issue as im useing the ThisDrawing.SendCommand "move 0,0". However I cannot seem to get vba to select the block so I can move it.

 

I cant use a window to select it because sometimes the block is over top of other geomatry or text and I dont want to move that. And the block isnt always in the same spot so I cant select it by insertion point. Hopefully this made sense.

 

Thank you in advance

 

 

cal-

 

Try this one

'publish by Design, Minkwitz
'Date: Mar/11/02
'Re: Assign selected text to block attribute
Option Explicit
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Function GetEnt() As AcadEntity
Dim Ent As AcadEntity
Dim Pt As Variant
Set Ent = Nothing
On Error Resume Next
Do
ThisDrawing.Utility.getentity Ent, Pt, "Pick an Object :"
If Err Then
If GetAsyncKeyState(&H1B) Then
Err.Clear
Exit Do
ElseIf ThisDrawing.GetVariable("errno") = "7" Or _
ThisDrawing.GetVariable("errno") = "52" Then
Err.Clear
End If
End If
If Not Ent Is Nothing Then
Set GetEnt = Ent
Exit Do
End If
Loop
End Function

Sub Try()
Dim oBlkRef As AcadBlockReference
Dim oEnt As AcadEntity
Dim insPt As Variant
Dim toPt As Variant
Set oEnt = GetEnt()
If Not TypeOf oEnt Is AcadBlockReference Then
MsgBox "Selected is not a block reference."
Else
Set oBlkRef = oEnt
insPt = oBlkRef.InsertionPoint
With ThisDrawing.Utility
toPt = .GetPoint(insPt, vbCr & "Specify second point:")
oEnt.Move insPt, toPt
End With
End If
End Sub

 

~'J'~

[BIGAL]

What about something like

 

Dim SS As AcadSelectionSet
Dim objENT As AcadEntity
Dim Count, Cntr As Integer
Dim Newpitname As String
Dim pitname As String
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"
BLOCK_NAME = "SCHEDTEXT"
Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
If SS.Item(Cntr).Name = BLOCK_NAME Then

attribs = SS.Item(Cntr).GetAttributes
If attribs(0).TextString = pitname Then

do move now

 

The code will find all blocks with block_name but the second filter checks the attribute pitname so only one block moves.

[clsnyder]

 

attribs = SS.Item(Cntr).GetAttributes

 

Thanks guys this has gotten me a bit closer. I guess I should have added a bit more information. See my problem is I have these old drawings, and the blocks on these drawings have been updated with new attributes. It is the function of my program to insert a new version of the block, then sync the old version with the new version, then delete the "new" version, which only leaves the one.

 

However when i do this, for some reason Autocad always moves the original block to another location. Which leads me back to having to move each block.

 

What type of veriable is attribs? it gives me a variable not defined error. Sorry AutoCad and I dont really get along. But thank you both for your help its been very useful.

[dbroada]

my guess would be that the new block and the existing block do not have the same insertion point as I have done this many times without a problem.

[clsnyder]

yeah they do have different insertion points. Which is part of the reason why I am updating these old blocks. that way in the future they all are the same and have the same insertion points.

[dbroada]

and that is why all your blocks are moving. When you sync the existing blocks to the new one the old insertion point stay where it is but the geometry will alter around it.

 

I once wrote a routine to shift all the blocks by x,y for somebody but they had all sorts of scales and rotations too so it wasn't very useful. Are all your blocks moving by the same amount or will you have to fiddle with it after you run your routine?

[clsnyder]

picture this

I have five years worth of drawings that have been made by X number of people. Each person made the drawing however they wanted but they all "look" the same. The blocks are named the same, and for the most part they have 90% of the same attributes in them.

 

So along I come and I have to bring all these old drawings and blocks into alignment. So, i drop in a new block, I sync it and then remove the block I just dropped in. Now the original block is up to date but totally in the wrong place. Because of how the drawings were all done, each block needs to be selected, then moved.

 

If I could use a mouse I could just click the block, type in the move command, and BAM its done. But I cant use a mouse because I have to automate the process.

 

So yeah, thats my drama. Why you couldnt just type in a "select Block X" command is beyond me.

[dbroada]

you can - use QSELECT

[clsnyder]

you can - use QSELECT

 

QSELECT isnt an option because it opens a window. the object was to automate everything to that the program does everything for you.

[dbroada]

in that case BigAl's selection set is probably the easiest way to progress. If you aren't doing any thing with attributes you don't need the two lines dealing with attribs. I'm guessing he posted a bit of code he already had sitting around.

 

my similar code will create a selection set of all the blocks in my drawing named STL*

 

gpCode(0) = 0 'item
gpCode(1) = 2 '?
groupCode = gpCode
dataValue(0) = "INSERT" 'item type
dataValue(1) = "STL*" '?
dataCode = dataValue
Set mySelSet = ThisDrawing.SelectionSets.Add("Blocks")
mySelSet.Select acSelectionSetAll, , , groupCode, dataCode
For Each myItem In mySelSet