Moving xref entities without changing the xref

I know I have seen this done before but I do not have access to the LISP or VBA routine that enabled it.

I am looking for a tool (VBA preferred) that will allow me to move an item in an xref without changing the xref itself. For example, if there is a room name in a drawing that causes the room to be too cluttered with linework, I would like to move it only in my drawing and not affect the other users. NCopy is not an option because I do not want to break a link to the information in that drawing (attributes, etc.). Help?

I already received a response in the general CAD forum that says this can't be done but I have seen it done and another engineer in my office has as well. The routine is out there I am just curious if someone knows how to accomplish this and is willing to share.

My first thought is that every object in the CAD drawing has a handle, and it may be possible to modify the X,Y,Z coordinates of the insert of a block by accessing it using a handle. Is this completely off base or do I have a start here?

 

I haven't seen such a program yet, but sounds interesting.

You would need to create a list of all entities
that are moved and record their position.
Then, you would need a program that would
react whenever that xref is loaded and move
the entities on the list to the recorded position

I doubt this could be made using VBA.

 

I'm open to LISP also, if you are aware of how it could be accomplished using that platform.

 

Hi Jorge,

With very few exceptions if you can do it in lisp you can do it in VBA.
What is described here can be done in VBA.

--


Laurie Comerford
CADApps
www.cadapps.com.au

 

thank you both for being encouraging...the other forum was not as much...

I have some sample code here that does part of what I want to do...maybe you can provide some suggestions to assist?

For testing purposes I created a simple form that has (3) list boxes, (3) text boxes, and (2) buttons. The first list box displays the names of the blocks found, the second displays the vaule of "j" (counter variable) and the insertion point of the block found, and the third list box displays the handle of the block. Most of this information will be used but it is not currently needed for the procedure to work. The text boxes are setup to count certain items for basic checking needs. The "List" button executes the procedure, the "Quit" button ends the procedure. After setting that up, here is the problem: The translation works, and when I rewrite the code (toggle +/- for the X,Y coordinates) the translation also works, but my zoom to extents still zooms to include where the translated block was (i.e. ~30,000,~30,000,0). Any ideas? Here is the code:

---------------------------------------------
Private Sub CmdList_Click()

Dim i As Integer
Dim bnam As String
Dim fullbnam As String
Dim EqpTag As AcadBlockReference
Dim TagInsert As Variant

ListName.Clear
ListType.Clear
ListHandle.Clear

Dim transMat(0 To 3, 0 To 3) As Double
transMat(0, 0) = 1#: transMat(0, 1) = 0#: transMat(0, 2) = 0#: transMat(0, 3) = 10000#
transMat(1, 0) = 0#: transMat(1, 1) = 1#: transMat(1, 2) = 0#: transMat(1, 3) = 10000#
transMat(2, 0) = 0#: transMat(2, 1) = 0#: transMat(2, 2) = 1#: transMat(2, 3) = 0#
transMat(3, 0) = 0#: transMat(3, 1) = 0#: transMat(3, 2) = 0#: transMat(3, 3) = 1#


For i = 0 To ThisDrawing.Blocks.Count - 1
If ThisDrawing.Blocks.Item(i).Name = "24197-mfp01" Then
For j = 0 To ThisDrawing.Blocks.Item(i).Count - 1
If TypeOf ThisDrawing.Blocks.Item(i).Item(j) Is AcadBlockReference Then
Set EqpTag = ThisDrawing.Blocks.Item(i).Item(j)
fullbnam = EqpTag.Name
bnam = Right(fullbnam, Len(fullbnam) - InStr(fullbnam, "|"))
If bnam = "MEQTAG" Then
ListName.AddItem bnam
TagInsert = EqpTag.InsertionPoint
ListType.AddItem j & " at " & TagInsert(0) & "," & TagInsert(1) & "," & TagInsert(2)
ListHandle.AddItem EqpTag.Handle
End If
End If
Set EqpTag = ThisDrawing.Blocks.Item(i).Item(586)
TagInsert = 0
EqpTag.TransformBy transMat
Next j
End If
Next i

TxtNameCount.Value = ListName.ListCount
TxtTypeCount.Value = ListType.ListCount
TxtHandleCount.Value = ListHandle.ListCount

End Sub

 

Be my guest.

 

Hi,

For selecting you blocks you may care to look at this code which will
quickly create
a selection set of blocks only. Just change the description "LWPOLYLINE" to
any type of AutoCAD object you want. This will enable you to work with a
smaller data set in you looping functions and speed things up overall.

--


Laurie Comerford
CADApps
www.cadapps.com.au

Sub ssTest()

Dim iTmp As Integer

Dim ssObjects As AcadSelectionSet


iTmp = SelectObjectsOnLayer(ssObjects, "LWPOLYLINE", "TEXTS")

iTmp = SelectObjectsOnLayer(ssObjects, "LINE", "TEXTS")


End Sub ' ssTest()

''''''''''''''''''''''''''''' '''''''''''''''''''

Public Function SelectObjectsOnLayer(ssObs As AcadSelectionSet, spObjectType
As String, spLayer As String) As Integer

On Error Resume Next

Dim FilterType(0 To 1) As Integer

Dim FilterData(0 To 1) As Variant

Dim sNumber As String

FilterType(0) = 0: FilterData(0) = spObjectType

FilterType(1) = 8: FilterData(1) = spLayer

' The line below will create an error if the SSET doesn't exist

' or delete it if it does exist.

' The ON Error will allow the program to continue and create the set

ThisDrawing.SelectionSets.Item("SSET").Delete

Set ssObs = ThisDrawing.SelectionSets.Add("SSET")

ssObs.Select acSelectionSetAll, , , FilterType, FilterData

SelectObjectsOnLayer = ssObs.Count

Exit Function


SOLErrorHandler:

Err.Clear

SelectObjectsOnLayer = 0

End Function ' SelectObjectsOnLayer()

you can provide some suggestions to assist?

text boxes, and (2) buttons. The first list box displays the names of the
blocks found, the second displays the vaule of "j" (counter variable) and
the insertion point of the block found, and the third list box displays the
handle of the block. Most of this information will be used but it is not
currently needed for the procedure to work. The text boxes are setup to
count certain items for basic checking needs. The "List" button executes
the procedure, the "Quit" button ends the procedure. After setting that up,
here is the problem: The translation works, and when I rewrite the code
(toggle +/- for the X,Y coordinates) the translation also works, but my zoom
to extents still zooms to include where the translated block was (i.e.
~30,000,~30,000,0). Any ideas? Here is the code:

TagInsert(1) & "," & TagInsert(2)