How to scale a block insert with VBA to AutoCad PaperSpace

[suwan116]

Hello all!

I had a task which was to allow a user to select a drawing frame (i.e. A4, A3, A1) from a user form and display it in autocad paper space, which i have achieved. However i need to display these drawing frames in scale. So if a user clicks on a combo box and selects 1: 1000 or 1:500 it will change to scale in paperspace.

Is something like this possible?

Cheers guys!

[fixo]

Hello all!

I had a task which was to allow a user to select a drawing frame (i.e. A4, A3, A1) from a user form and display it in autocad paper space, which i have achieved. However i need to display these drawing frames in scale. So if a user clicks on a combo box and selects 1: 1000 or 1:500 it will change to scale in paperspace.

Is something like this possible?
Cheers guys!

See Split function in VBA Help
It will divide the string by delimiter in our case it is a double dot


Private Sub UserForm_Initialize()
ComboBox1.AddItem "A1"
ComboBox1.AddItem "A2"
ComboBox1.AddItem "A3"
ComboBox1.AddItem "A4"
ComboBox2.AddItem "1:1"
ComboBox2.AddItem "1:10"
ComboBox2.AddItem "1:100"
ComboBox2.AddItem "1:200"
ComboBox2.AddItem "1:1000"
ComboBox2.AddItem "1:5000"
End Sub
Private Sub CommandButton2_Click()
Dim myBlock As AcadBlockReference
Dim blockInsert(0 To 2) As Double
Dim scaleStr As String
Dim frameDwg As String
If ComboBox2.Text = vbNullString Then
MsgBox "Select Scale!"
End If
scaleStr = ComboBox2.Text '<-- get selected scale
Dim tmp As Variant
tmp = Split("1:1000", ":", -1, vbTextCompare)'<--here it is
Dim scl As Double
scl = CDbl(tmp(1))
MsgBox scl
frameDwg = ComboBox1.Text '<-- get selected file name
Dim dwgName As String
dwgName = frameFolder & frameDwg & ".dwg" '<--build a full path of drawing here
If Not FileExist(dwgName) Then
MsgBox "File:" & vbCr & dwgName & " does not exists"
Exit Sub
End If
MsgBox dwgName
blockInsert(0) = -18
blockInsert(1) = -6
blockInsert(2) = 0
ThisDrawing.ActiveLayout = ThisDrawing.Layouts.Item("Layout1")
Set myBlock = ThisDrawing.PaperSpace.InsertBlock(blockInsert, dwgName, scl, scl, scl, 0)
ComboBox1.ListIndex = -1 '<--refresh combo
ComboBox2.ListIndex = -1 '<--refresh combo
End Sub


Forgot to told, I have not have so much time to answer to you often, sorry

~'J'~

[suwan116]

Mate, you've been most helpful with the coding.

Thanks very much! You seem to know your stuff a lot!

[fixo]

No problem,
Correction, must be:


scl = 1.0/CDbl(tmp(1))

[suwan116]

Sorry mate, just one more thing.

This bit of coding:

tmp = Split("1:1000", ":", -1, vbTextCompare)

This only allows me to select 1:1000 scale. How would i make it so i can choose 1:1000, 1:500, 1:250 etc...

I tried this, however got an error:

tmp = Split("1:1000", "1:500", "1:250", -1, vbTextCompare)

[fixo]

Sorry my fault
Must be


tmp = Split(scaleStr,":", -1, vbTextCompare)'<--here it is

[suwan116]

Hey, Thanks for getting back to me. I tried this new bit of coding. However i get a error with this bit:

scl = 1.0/CDbl(tmp(1)) ( I even tried the old code scl = CDbl(tmp(1)) )

Never mind, il keep trying.

[fixo]

How about:
scl = 1.0/Val(Trim(tmp(1)))

???

Will be back tomorrow, Zzzzzzzzz

[suwan116]

hey, still the same error. cheers anyway. goodnight

[fixo]

I've tested on my machine right now
scl=1#/Val(tmp(1))
it's working good here
Perhaps problem with other part of your code
Just a hint:
You could to divide string using Instr and Right function too

~'J'~

[suwan116]

Yeah il have a go at it. I can scale at 1:1000, i think i might get away with that. Thanks for your help. I really appriciate all your support.

[fixo]

You are welcome,
look at this
http://www.visiblevisual.com/index.php/Table/AutoCad-VBA/
hth

[suwan116]

Hey, thanks i managed to sort out the scale issue. I wanted to know one more thing, im sorry to be a pain!

But im trying to show text in paperspace. I've manged to do this for one of the text boxes, so when a users fills the text box in it displays it in paper space. I used the following code to achive this:

Dim userText As String
userText = UserForm1.txttitle.Text
InsPt(0) = 720: InsPt(1) = 80: InsPt(2) = 0
Set mText = ThisDrawing.PaperSpace.AddText(userText, InsPt, 4)

This code displays the text inserted by the user to show the 'Title' and shows it in paperspace in the right location. However i cant seem to get the second text box to display in paperspace.

My second textbox is called 'txtcode.Text'
And insertionpoint: InsPt(0) = 720: InsPt(1) = 100: InsPt(2) = 0


Can you suggest anything? Cheers!

[suwan116]

Actuallly never mind, i found out how:

'Insertion of text into drawing frames
Dim text1Obj As AcadText
Dim xpos1(0 To 2) As Double
Dim userText As String

userText = UserForm1.txttitle.Text
xpos1(0) = 720: xpos1(1) = 80: xpos1(2) = 0
Set text1Obj = ThisDrawing.PaperSpace.AddText(userText, xpos1, 4)

Dim text2Obj As AcadText
Dim xpos2(0 To 2) As Double
Dim userText2 As String

userText2 = UserForm1.txtcode.Text
xpos2(0) = 720: xpos2(1) = 100: xpos2(2) = 0
Set text2Obj = ThisDrawing.PaperSpace.AddText(userText2, xpos2, 4)

[fixo]

Glad you got it to work
Happy computing :)