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)'<--[color=darkred][b]here it is[/b][/color]
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'~

Edited March 31, 2011 by fixo
spell check

[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