Insertion point of blocks and attibuts.

Hi,

I'm inserting blocks that I created in code, if the Insert point of the
block is 0,0,0 the atttributs get inserted at the right place.

But if I create a block with a different insertion point the attributs are
inserted as if the block was created with 0,0,0.

How can I get my attributs to be inserted at the right place if my block is
not created at 0,0,0 for insertion point.

Thanks.

 

Post the code where you create the block and the attributes. Your issue
is probably created there.


--
egc - Sudden Supernumerary

Part of todays conversation:
e: Why aren't the Foundation Notes on the Foundation sheet?
o: Well we used to have them there, but then the subs wouldn't do what
the notes said so the building inspector would not signoff on the
inspection. So we decided to take off the notes.

 

Probably not. I can reproduce this consistently. Create a block with
attributes anywhere in the drawing editor, having an insertion point of
anything but 0,0. Insert it via the command and give the attributes
values.....it will insert as expected. Now, in vba (or lisp with ActvieX
methods) insert that same block and the attributes will be inserted at a
point equal to the original insertion point selected during the block
creation process plus the new insertion point.

For example, new block with 1 attribute created with insertion point of the
new block & attribute at 100,100. Insert via vba at 100,100. The block
insertion point will be 100,100, but the attrib. will be placed at 200,200.

So, the solution is: apply a transformation to the inserts of the
attrib.ref's based on the blocks origin vs the insertion point.

Jeff

 

also a block created anywhere but at 0,0 won't work with trim and extend
commands
my block routine moves the stuff to be blocked to 0,0 before blocking, just
to keep acad happy

 

commands

GRRRR!!!!! I've been trying to figure that one out for about 6 months, and
it turns out I knew the answer for most of those 6 months......

Double Grrrrrrr!

;-)

 

Well Jeff the orginal poster said he was "creating the block (and I
assume) attributes in code". I do this all the time but I always have
started by adding the block to the blocks collection at 0,0,0. I then
add the attributes based on relative coordinates but since I started at
0,0, I treat them as absolute (no transformations). These blocks are
then inserted at wherever the code (or the user) wants them. And,
surprise, I have never had attributes spinning in space (but maybe I
have been lucky). What you are "reproducing ... consistently" is what
the original poster wanted to avoid. You solution (apply a
transformation) is more work and avoidable.


--
egc - Sudden Supernumerary

Part of todays conversation:
e: Why aren't the Foundation Notes on the Foundation sheet?
o: Well we used to have them there, but then the subs wouldn't do what
the notes said so the building inspector would not signoff on the
inspection. So we decided to take off the notes.

 

egc,
I, too create the blocks & attributes @ 0,0,0. However, the OP specifically
asked what to do when they weren't:

"But if I create a block with a different insertion point the attributs are
inserted as if the block was created with 0,0,0.

How can I get my attributs to be inserted at the right place if my block is
not created at 0,0,0 for insertion point."

I was just answering his question....

Jeff

 

I guess the real discussion should be that when you add attributes to a
block, VBA assumes that the coordinates that you supply are "block
based" or OCS. So your point was to simply make this translation when
he adds the attributes. Okay.


--
egc - Sudden Supernumerary

Part of todays conversation:
e: Why aren't the Foundation Notes on the Foundation sheet?
o: Well we used to have them there, but then the subs wouldn't do what
the notes said so the building inspector would not signoff on the
inspection. So we decided to take off the notes.

 

Here is the code... hope it's not too messy!

I tried to change the insPt below to the bottom right of my "rectangle" but
when I do that the attributs are not at the right place.

How to figure out the corrections to Pttext,

insPt(0) = 0: insPt(1) = 0: insPt(2) = 0
'la cartouche (block) n'existe pas
Set objblock = ThisDrawing.Blocks.Add(insPt, "Cartouche")
'ThisDrawing.PaperSpace.InsertBlock
'cartouche régulière carte 80X100
pt1(0) = pt2(0) - 130
pt1(1) = pt2(1) + 75
Set objTmp = Rectangle(pt1, pt2, "Cartouche")
'ajoute au block
ptText(0) = pt1(0) + 3
'ici
ptText(1) = minY + 3.5
Dim objAttr As AcadAttribute
For i = 0 To 3
Set objtext = objblock.AddText(TitreCart(i), ptText, 2.5)
With objtext
.Alignment = acAlignmentMiddleLeft
.TextAlignmentPoint = ptText
.Update
End With
ptText(0) = ptText(0) + 25
Set objAttr = objblock.AddAttribute(2.5, acAttributeModeNormal, "",
ptText, cartTag(i), cartText(i))
With objAttr
.Alignment = acAlignmentMiddleLeft
.TextAlignmentPoint = ptText
.Update
End With
ptText(0) = ptText(0) - 25
ptText(1) = ptText(1) + 7
Next

ptText(1) = ptText(1) - 7
ptText(0) = ptText(0) + 65
'nom de fichier
Set objAttr = objblock.AddAttribute(1.5, acAttributeModeNormal, "",
ptText, "NomFichier", frmCadre.txtNomFichier)
With objAttr
.Alignment = acAlignmentMiddleLeft
.TextAlignmentPoint = ptText
.Update
End With
'Dessin de l'échelle
ptText(0) = maxX - 32.5
ptText(1) = minY + 3.5
Dim txtEchelle As String
txtEchelle = "1 : " & frmCadre.txtScale
Set objAttr = objblock.AddAttribute(1.5, acAttributeModeNormal, "",
ptText, "Echelle", txtEchelle)
With objAttr
.Alignment = acAlignmentCenter
.TextAlignmentPoint = ptText
.Update
End With
ptText(0) = maxX - 32.5
ptText(1) = ptText(1) + 3
'dessine l'échelle
Call drawScale(ptText, Val(frmCadre.txtScale))
ptText(1) = minY + 43.8
ptText(0) = maxX - 65
'titres
Set objAttr = objblock.AddAttribute(5.4, acAttributeModeNormal, "",
ptText, "Projet", frmCadre.txtProjet)
With objAttr
.Alignment = acAlignmentCenter
.TextAlignmentPoint = ptText
.Update
End With
ptText(1) = minY + 34.8
Set objAttr = objblock.AddAttribute(4.5, acAttributeModeNormal, "",
ptText, "Titre2", frmCadre.txtTitre)
With objAttr
.Alignment = acAlignmentCenter
.TextAlignmentPoint = ptText
.Update
End With
'logo Cambior
ptText(1) = minY + 59.8

 

Yves,

If you can repost this with formatting (indentation) and use the "[
vbcode ][ /vbcode ]" tags for vba formatting it would help my tired
eyes. You also have some variables being used that aren't initialized
in the code that you posted, as well as some objects being created but
not apparently used. So I am not sure what you are doing. Maybe it
will look clearly tomorrow <)


--
egc - Sudden Supernumerary

Part of todays conversation:
e: Why aren't the Foundation Notes on the Foundation sheet?
o: Well we used to have them there, but then the subs wouldn't do what
the notes said so the building inspector would not signoff on the
inspection. So we decided to take off the notes.

 

Yves,

Okay. Assume the following:
Rectangle 100 (width in X) x 80 (height in Y) rectangle
Block InsertionPoint is at bottom right corner of rectangle
You have an attribute at each corner of the rectangle


[vbcode]
Public Sub CreateBlock()
Dim dWidth As Double, dHeight As Double, dPt1(0 To 2) As Double
Dim aBlk As AcadBlock, aAtt As AcadAttribute, aPoly As AcadPolyline,
sBlkName As String

dPt1(0) = 0#
dPt1(1) = 0#
dPt1(2) = 0#
dWidth = 100#
dHeight = 80#

sBlkName = "MyBlock1"
On Error GoTo ChgBlkName
Set aBlk = ThisDrawing.Blocks.Add(dPt1, sBlkName)
GoTo Cont
ChgBlkName:
' Add Routine to Change Block Name
On Error GoTo BadBlkName
Set aBlk = ThisDrawing.Blocks.Add(dPt1, sBlkName)
' Set Block attributes such as layer, color, etc.
GoTo Cont
BadBlkName:
MsgBox ("Error in CreateBlock: Unable to Add Block " + sBlkName + "
to Blocks Collections")
Exit Sub
Cont:
'Add Rectangle as Polyline
Dim dPts(0 To 11) As Double
dPts(0) = -dWidth: dPts(1) = 0#: dPts(2) = 0# ' Bottom Left
dPts(3) = 0#: dPts(4) = 0#: dPts(5) = 0# ' Bottom Right
dPts(6) = 0#: dPts(7) = dHeight: dPts(8) = 0# ' Top Right
dPts(9) = -dWidth: dPts(10) = dHeight: dPts(11) = 0# ' Top Left
Set aPoly = aBlk.AddPolyline(dPts)
aPoly.Closed = True
' Set Polyline attributes such as layer, color, etc.

'Add Attributes
dPt1(0) = -dWidth: dPt1(1) = 0#: dPt1(2) = 0#
Set aAtt = aBlk.AddAttribute(2.5, acAttributeModeNormal, "BL Data",
dPt1, "BL", "Bottom Left")
aAtt.Alignment = acAlignmentMiddleCenter
aAtt.TextAlignmentPoint = dPt1
aAtt.Update

dPt1(0) = 0#: dPt1(1) = 0#: dPt1(2) = 0#
Set aAtt = aBlk.AddAttribute(2.5, acAttributeModeNormal, "BR Data",
dPt1, "BR", "Bottom Right")
aAtt.Alignment = acAlignmentMiddleCenter
aAtt.TextAlignmentPoint = dPt1
aAtt.Update

dPt1(0) = 0#: dPt1(1) = dHeight: dPt1(2) = 0#
Set aAtt = aBlk.AddAttribute(2.5, acAttributeModeNormal, "TR Data",
dPt1, "TR", "Top Right")
aAtt.Alignment = acAlignmentMiddleCenter
aAtt.TextAlignmentPoint = dPt1
aAtt.Update

dPt1(0) = -dWidth: dPt1(1) = dHeight: dPt1(2) = 0#
Set aAtt = aBlk.AddAttribute(2.5, acAttributeModeNormal, "TL Data",
dPt1, "TL", "Top Left")
aAtt.Alignment = acAlignmentMiddleCenter
aAtt.TextAlignmentPoint = dPt1
aAtt.Update

' Insert Block
dPt1(0) = dPt1(1) = 200#
dPt1(2) = 0#
ThisDrawing.ModelSpace.InsertBlock dPt1, sBlkName, 1#, 1#, 1#, 0#

End Sub
[/vbcode]


Most of the hardcoded data could be passed into the sub as arguments.

HTH


--
egc - Sudden Supernumerary

Part of todays conversation:
e: Why aren't the Foundation Notes on the Foundation sheet?
o: Well we used to have them there, but then the subs wouldn't do what
the notes said so the building inspector would not signoff on the
inspection. So we decided to take off the notes.