insertblock problem

[Anonymous]

Hello,
I have the following code:

Sub leftDoor(blockname)
Rem dimension all the variables
Dim hp(0 To 2) As Double 'hp is the hing point
Dim lp(0 To 2) As Double 'lp is the latch point
Dim varret As Variant
Dim blockobj As AcadBlockReference
Dim truefalse As Boolean
Dim entry As AcadLayer
Dim contnue As Boolean
Dim onerunthru As Boolean
Dim doorscale As Double
Dim doorangle As Double
Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Rem initialize the variables
contnue = True
truefalse = False
layertouse = ""
onerunthru = False

Rem ** Do While contnue = True
Rem check to see if a door layer exists
For Each entry In ThisDrawing.Layers
If (entry.Name = "Door" Or entry.Name = "DOOR" Or entry.Name = "door" Or entry.Name = "Dr" Or entry.Name = "DR" Or entry.Name = "dr") Then
truefalse = True
layertouse = entry.Name
End If
Next

If truefalse = True Then
Rem insert the correct door block once the inserttion layer is known
Rem get the hinge point
varret = ThisDrawing.Utility.GetPoint(, "Enter the hinge point: ")
hp(0) = varret(0)
hp(1) = varret(1)
hp(2) = varret(2)
Rem get the latch point
varret = ThisDrawing.Utility.GetPoint(, "Enter the latch point: ")
lp(0) = varret(0)
lp(1) = varret(1)
lp(2) = varret(2)
Rem calculate the scale for the door block
doorscale = Sqr(((hp(0) - lp(0)) ^ 2) + ((hp(1) - lp(1)) ^ 2) + ((hp(2) - lp(2)) ^ 2))
Rem calculate the angle to insert the block
Rem doorangle = ThisDrawing.Utility.AngleFromXAxis(hp, lp) + (3.14159 / 2)
doorangle = ThisDrawing.Utility.AngleFromXAxis(hp, lp)

Rem insert the correct door block
Set blockobj = ThisDrawing.ModelSpace.InsertBlock(hp, blockname, doorscale, doorscale, doorscale, doorangle)
Rem set the inserted block to the correct door layer
blockobj.Layer = layertouse
blockobj.Update
contnue = False 'set a variable to exit out of the loop
Else
Rem ask the user if they want to create a layer or use an existing layer.
If onerunthru = False Then
Msg = "A door layer does not exist. Do you want to create one or use an existing layer?"
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Error! No Layer for Doors" ' Define title.
Response = MsgBox(Msg, Style, Title)
End If

If Response = vbYes Then ' User chose Yes.
Rem if they want to use an existing layer, then use the dialog box
createdoordlg.Show
truefalse = False
onerunthru = True
Else
Rem display an error message if they answered NO
MsgBox "I can not create the door without a layer to insert the Door onto. I will now exit this command!"
contnue = False
End If
End If
Rem ** Loop
End Sub

This will insert the block fine, but it rotates all the blocks with the same name by 90 degrees. Why is it doing this?

[Anonymous]

Are you inserting the block from an external source, which may be redefining
the block definition?

--
R. Robert Bell


wrote in message news:4932460@discussion.autodesk.com...
Hello,
I have the following code:

Sub leftDoor(blockname)
Rem dimension all the variables
Dim hp(0 To 2) As Double 'hp is the hing point
Dim lp(0 To 2) As Double 'lp is the latch point
Dim varret As Variant
Dim blockobj As AcadBlockReference
Dim truefalse As Boolean
Dim entry As AcadLayer
Dim contnue As Boolean
Dim onerunthru As Boolean
Dim doorscale As Double
Dim doorangle As Double
Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Rem initialize the variables
contnue = True
truefalse = False
layertouse = ""
onerunthru = False

Rem ** Do While contnue = True
Rem check to see if a door layer exists
For Each entry In ThisDrawing.Layers
If (entry.Name = "Door" Or entry.Name = "DOOR" Or entry.Name =
"door" Or entry.Name = "Dr" Or entry.Name = "DR" Or entry.Name = "dr") Then
truefalse = True
layertouse = entry.Name
End If
Next

If truefalse = True Then
Rem insert the correct door block once the inserttion layer is
known
Rem get the hinge point
varret = ThisDrawing.Utility.GetPoint(, "Enter the hinge point:
")
hp(0) = varret(0)
hp(1) = varret(1)
hp(2) = varret(2)
Rem get the latch point
varret = ThisDrawing.Utility.GetPoint(, "Enter the latch point:
")
lp(0) = varret(0)
lp(1) = varret(1)
lp(2) = varret(2)
Rem calculate the scale for the door block
doorscale = Sqr(((hp(0) - lp(0)) ^ 2) + ((hp(1) - lp(1)) ^ 2) +
((hp(2) - lp(2)) ^ 2))
Rem calculate the angle to insert the block
Rem doorangle = ThisDrawing.Utility.AngleFromXAxis(hp, lp) +
(3.14159 / 2)
doorangle = ThisDrawing.Utility.AngleFromXAxis(hp, lp)

Rem insert the correct door block
Set blockobj = ThisDrawing.ModelSpace.InsertBlock(hp, blockname,
doorscale, doorscale, doorscale, doorangle)
Rem set the inserted block to the correct door layer
blockobj.Layer = layertouse
blockobj.Update
contnue = False 'set a variable to exit out of the loop
Else
Rem ask the user if they want to create a layer or use an
existing layer.
If onerunthru = False Then
Msg = "A door layer does not exist. Do you want to create
one or use an existing layer?"
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define
buttons.
Title = "Error! No Layer for Doors" ' Define title.
Response = MsgBox(Msg, Style, Title)
End If

If Response = vbYes Then ' User chose Yes.
Rem if they want to use an existing layer, then use the
dialog box
createdoordlg.Show
truefalse = False
onerunthru = True
Else
Rem display an error message if they answered NO
MsgBox "I can not create the door without a layer to insert
the Door onto. I will now exit this command!"
contnue = False
End If
End If
Rem ** Loop
End Sub

This will insert the block fine, but it rotates all the blocks with the same
name by 90 degrees. Why is it doing this?

[Anonymous]

Hi schaubro,
As Robert mentioned, there may be a problem with the block you are inserting, but in addition..... you are setting the "z scale factor" of your block to the value of "doorscale".
Also, what you are doing with anglefromxaxis is not wrong, but I find that personally it seems easier to just create a line, use the line's properties repeatedly as needed, then delete the line. In other words:

dim Lin as acadline, pt1, pt2
'getpoints - no need to convert between variant and double
set lin = thisdrawing.modelspace.addline (pt1, pt2)

then use "lin.angle" as your insertion angle and "lin.delete" at the end.

[Anonymous]

thanks for the help.

I have found that the program was reloading the block and the block defined on the computer was not the same as in the drawing.

Is there a way to insertblock without reloading the block from the block file, but by using it as defined in the drawing (provided it exists in the drawing).

thanks for all the other help,
tim

[Anonymous]

Iterate thru the Blocks collection. If it isn't there, insert from the
external location.

--
R. Robert Bell


wrote in message news:4932568@discussion.autodesk.com...
thanks for the help.

I have found that the program was reloading the block and the block defined
on the computer was not the same as in the drawing.

Is there a way to insertblock without reloading the block from the block
file, but by using it as defined in the drawing (provided it exists in the
drawing).

thanks for all the other help,
tim