VB script issues

[Anonymous]

Hello everyone,

I am a regular CAD user, but haven't really used scripting before in the product. I have a piece of code which apparently was created years ago by someone and should work, but doesn't. I am trying to debug and fix it if possible.

The code is supposed to prompt the user for a block name and then insert it, whilst allowing the user to specify insertion point, and the angle etc.

Would be very grateful if anyone could give the code a quick look through and see if there are any obvious issues.

EDIT - forgot to say, the prompt appears and I can enter a block name, it then allows me to click an insert point and a second point, but then nothing happens.

Many thanks

Matt

------------------------------------------

Option Explicit
Dim FirstPnt As Variant: Dim SecondPnt As Variant
Dim Angle As Double
Dim Name As String
Dim Xscale As Double: Dim Yscale As Double: Dim Yratio As Double
Dim DX As Double: Dim DY As Double
Dim Ratio As Boolean
Dim Blockobject As AcadEntity
Public Pick As Boolean

Public Sub Fblock()
On Error GoTo Errorhandler

Dim Errortxt As String
Dim Keyword As String

Do
'Show form and get values
Pick = False
frmFBlock.Show
If Not Pick Then Exit Sub
Name = frmFBlock.txtName
Yratio = Val(frmFBlock.txtYscale)
Ratio = frmFBlock.chkRatio

'Check blockname exists
If Checkblock() = False Then
MsgBox ("Block does not exist")
Exit Sub
End If

Do
'Pick first point, exit or return to settings
ThisDrawing.Utility.InitializeUserInput 1, "Settings eXit"
On Error Resume Next
FirstPnt = ThisDrawing.Utility.GetPoint(, "Pick head, or [Settings eXit] <Settings: ")
Errortxt = Err.Description
On Error GoTo Errorhandler
If Errortxt = "User input is a keyword" Then
Keyword = ThisDrawing.Utility.GetInput()
If Keyword = "eXit" Then Exit Sub
If Keyword = "Settings" Then Exit Do
End If
'Pick second point
ThisDrawing.Utility.InitializeUserInput 1
SecondPnt = ThisDrawing.Utility.GetPoint(FirstPnt, "Pick tail:")

'Calculate Xscale factor
DX = FirstPnt(0) - SecondPnt(0)
DY = FirstPnt(1) - SecondPnt(1)
Xscale = Sqr(DX ^ 2 + DY ^ 2)

'Calculate angle of block
Angle = ThisDrawing.Utility.AngleFromXAxis(FirstPnt, SecondPnt)

'Calculate Y ratio relative to X scale factor
If Ratio Then
Yscale = Xscale
Else
Yscale = Yratio * Xscale
End If

'Insert block
Set Blockobject = ThisDrawing.ModelSpace.InsertBlock(FirstPnt, Name, Xscale, Yscale, 1, Angle)

Loop While True
Loop While True

Exit Sub

Errorhandler:
MsgBox "Utility aborted", , "FlexiBlock"
End Sub

Function Checkblock()

Dim Check As AcadBlock
On Error Resume Next
Set Check = ThisDrawing.Blocks.Item(Name)
If Err <> 0 Then
Checkblock = False
Else
Checkblock = True
End If

End Function

[Ed__Jobe]

Can't really test it without the form. Since the form apparently has code in it too, I don't know what it should do. You might want to zip and post the dvb.

[Anonymous]

Hi Ed,

Thanks for the reply. Attached is the .dvb, and also the 'HASH' .dwg we are trying to use - is this all you need?

Thanks,

Matt

[Ed__Jobe]

I took a quick look at it. Its stuck in a loop at the prompt. The trouble is, from the design of the form, I don't know what it is that you are trying to accomplish. What exactly do you want the command to do? So far it just looks like a simple version of the INSERT command.

[Anonymous]

Hi Ed,

Thanks for taking another look. We're using CAD for archaeological plans, in which we sometimes use hachures to signify steepness of a feature. So I think the idea of the original programmer was to create a hachure block, which in our case is called HASH, and then write a script which would do an insert. When you run the script, it basically asks you where you want the hachure to begin and end and then tries to work out the angle so that it looks right.

I don't really understand why he used a form though, it just seems to add another level of complexity. Couldn't we just do away with the form and hardcode the input in the command?

So instead of having...

Set Blockobject = ThisDrawing.ModelSpace.InsertBlock(FirstPnt, Name, Xscale, Yscale, 1, Angle)

with the form prompt, we could have...

Set Blockobject = ThisDrawing.ModelSpace.InsertBlock(FirstPnt, "HASH", Xscale, Yscale, 1, Angle)

cutting out a lot of code and possible cause of the issue?

Thanks

Matt

[Ed__Jobe]

So you're always going to use the same block and only one block? You don't want it to be "Flexi"ble for handling multiple blocks?

[Anonymous]

I think that may have been the original idea, but as far as I know it has only ever been used by that one block. I think getting it working is the priority, flexibility is unimportant at the moment.

[Ed__Jobe]

I'm still working on it, but I noticed one thing. The app only inserts the block in model space. If you are using it in paper space, it may seem to not be working. Flip to model space and you'll probably find a bunch of blocks inserted. Check it out.

[Anonymous]

Thanks, yeah definitely working in model space. Still doesn't seem to work.

[Ed__Jobe]

I made several improvements, all documented with comments. I also formatted/indents for better readability.

I changed the TextBox to a ComboBox so that you don't have to type in a block name. It could also be made to load the block if its not already in the dwg.