[求助] 关于VBA 2次AUTOCAD开发的问题
我现在遇到个问题，，需要用VB直接对AUTOCAD的图进行动态改变大小，并且能有标住的尺寸！！搞的我有点茫然了，，
请问有高手高手高高手，能给我指点下吗？？有简单几句代码提示最好了！！
小弟谢谢了！！！！！！！！
我已前收集到的代码..你看看...希望对你有帮助..
Option Explicit
Dim Acadapp As Object '定义AutoCAD对象
Dim AcadDoc As Object '定义AutoCAD的当前图形
Dim MoSpace As Object '定义AutoCAD的模型空间对象
Dim intA As Integer '定义源比例尺选择标志
Dim intB As Integer '定义目的比例尺选择标志
Private Sub cmdCancel_Click()
End
End Sub
Private Sub cmdOK_Click()
Dim aItem As Object
Dim i As Long '循环变量
Dim lngMosObject As Long '图形中实体的数量
Dim InsPt As Variant '定义文字插入点
Dim dblTextH As Double '定义图形中原文字的高度
Dim dblScaleA As Double '定义原图形比例尺
Dim dblScaleB As Double '定义目的图形比例尺
Dim strScaleA, strScaleB As String '定义输入比例尺字符串
Dim intFlag As Integer '定义给定的比例尺是否为10的倍数标志
Dim blnScaleFlag As Boolean '定义检查比例尺输入检查标志
Dim strPrompt As String '比例尺输入检查提示
Dim strTitle As String '检查提示的标题
Dim dblBlockXscale As Double '定义块的X比例
Dim dblBlockYscale As Double '定义块的Y比例
Dim InsBlockPt As Variant '定义块的插入点
Select Case intA '源比例尺的选择
Case 1 '源比例尺为500
dblScaleA = 500#
Select Case intB
Case 1
MsgBox "您选择的源比例尺和目的比例尺相同，不必转换！", vbInformation + vbOKOnly, "比例尺转换"
End
Case 2
dblScaleB = 1000#
Case 3
dblScaleB = 2000#
Case 4
strScaleB = TxtB.Text
strPrompt = "目的比例尺"
strTitle = "目的比例尺"
blnScaleFlag = blnCheckInput(strTitle, strPrompt, strScaleB)
If Not blnScaleFlag Then
TxtB.SetFocus
Exit Sub
End If
dblScaleB = CDbl(strScaleB)
End Select
Case 2 '源比例尺为1000
dblScaleA = 1000#
Select Case intB
Case 1
dblScaleB = 500#
Case 2
MsgBox "您选择的源比例尺和目的比例尺相同，不必转换！", vbInformation + vbOKOnly, "比例尺转换"
End
Case 3
dblScaleB = 2000#
Case 4
strScaleB = TxtB.Text
strPrompt = "目的比例尺"
strTitle = "目的比例尺"
blnScaleFlag = blnCheckInput(strTitle, strPrompt, strScaleB)
If Not blnScaleFlag Then
TxtB.SetFocus
Exit Sub
End If
dblScaleB = CDbl(strScaleB)
End Select
Case 3 '源比例尺为2000
dblScaleA = 2000#
Select Case intB
Case 1
dblScaleB = 500#
Case 2
dblScaleB = 1000#
Case 3
MsgBox "您选择的源比例尺和目的比例尺相同，不必转换！", vbInformation + vbOKOnly, "比例尺转换"
End
Case 4
strScaleB = TxtB.Text
strPrompt = "目的比例尺"
strTitle = "比例尺转换"
blnScaleFlag = blnCheckInput(strTitle, strPrompt, strScaleB)
If Not blnScaleFlag Then
TxtB.SetFocus
Exit Sub
End If
dblScaleB = CDbl(strScaleB)
End Select
Case 4 '源比例尺为自定义
strScaleA = TxtA.Text
strPrompt = "源比例尺"
strTitle = "比例尺转换"
blnScaleFlag = blnCheckInput(strTitle, strPrompt, strScaleA)
If Not blnScaleFlag Then
TxtA.SetFocus
Exit Sub
End If
dblScaleA = CDbl(strScaleA)
Select Case intB
Case 1
dblScaleB = 500#
Case 2
dblScaleB = 1000#
Case 3
dblScaleB = 2000#
Case 4
strScaleB = TxtB.Text
strPrompt = "目的比例尺"
strTitle = "目的比例尺"
blnScaleFlag = blnCheckInput(strTitle, strPrompt, strScaleB)
If Not blnScaleFlag Then
TxtB.SetFocus
Exit Sub
End If
dblScaleB = CDbl(strScaleB)
End Select
End Select
'判断自定义比例尺是否为10的倍数
If (Fix(dblScaleA / 10#) <> (dblScaleA / 10#)) Or (Fix(dblScaleB / 10#) <> dblScaleB / 10#) Then
intFlag = MsgBox("您给出的比例尺不是10的倍数，是否继续？", vbYesNo + vbExclamation, "比例尺转换")
If intFlag = vbNo Then
Exit Sub
End If
End If
'frmMian.Hide
'当转换的比例尺合乎要求后，进行转换
'因该程序是直接在Auto CAD下使用的，所以CAD当然是启动的
'因此不必进行CAD是否已经启动的判断
Set Acadapp = GetObject(, "AutoCAD.application")
Set AcadDoc = Acadapp.ActiveDocument
Set MoSpace = AcadDoc.ModelSpace
'得到当前图形中的实体数量
lngMosObject = MoSpace.Count - 1
For i = 0 To lngMosObject
Set aItem = MoSpace.Item(i)
If aItem.EntityType = acText Or aItem.EntityType = acMtext Then '查询文字
InsPt = aItem.insertionPoint '得到文字的插入点
dblTextH = aItem.Height '得到文字的高度
dblTextH = dblTextH * (dblScaleB / dblScaleA) '对文字高度进行转换
aItem.Height = dblTextH '使文字具有新的高度
aItem.insertionPoint = InsPt '保持文字的插入点不变
aItem.Update '刷新文字
Else
If aItem.EntityType = acBlockReference Then '查询块
'得到块的插入点
InsBlockPt = aItem.insertionPoint
'得到块的比例系数
dblBlockXscale = aItem.XScaleFactor
dblBlockYscale = aItem.YScaleFactor
'得到块的新比例系数
dblBlockXscale = dblBlockXscale * (dblScaleB / dblScaleA)
dblBlockYscale = dblBlockYscale * (dblScaleB / dblScaleA)
aItem.insertionPoint = InsBlockPt
'更新块的比例系数
aItem.XScaleFactor = dblBlockXscale
aItem.YScaleFactor = dblBlockYscale
'刷新块
aItem.Update
End If
End If
Next i
MsgBox "比例尺转换完毕！", vbOKOnly + vbInformation, "比例尺"
End
End Sub
Private Sub Form_Load()
'选项初始化
OptA(1).Value = True
OptB(1).Value = True
TxtA.Text = 5000
TxtB.Text = 5000
TxtA.Enabled = False
TxtB.Enabled = False
End Sub
Private Sub OptA_Click(Index As Integer)
'源比例尺选项
intA = Index + 1
If intA = 4 Then
TxtA.Enabled = True
Else
TxtA.Enabled = False
End If
End Sub
Private Sub OptB_Click(Index As Integer)
'目的比例尺选项
intB = Index + 1
If intB = 4 Then
TxtB.Enabled = True
Else
TxtB.Enabled = False
End If
End Sub
Option Explicit
'本函数用来检查文本框的输入是否为数字
'调用参数为：提示标题、提示字符串、需检查的内容
Public Function blnCheckInput(strTitle As String, strPrompt As String, strText) As Boolean
Dim strTmp As String '定义临时字符串
Dim intI As Integer '定义循环变量
If strText = "" Then '如果字符串为空，则提示
MsgBox strPrompt & "不能为空！", vbOKOnly + vbExclamation, strTitle
blnCheckInput = False
Exit Function
Else '如果字符串不为空，则检查其中是否含有非数字内容
For intI = 1 To Len(strText)
strTmp = Mid(strText, intI)
If (Asc(strTmp) <> 46) And (Asc(strTmp) < 48 Or Asc(strTmp) > 57) Then
MsgBox strPrompt & "不能含有字符！", vbOKOnly + vbExclamation, strTitle
blnCheckInput = False
Exit Function
End If
Next intI
End If
strTmp = Left(strText, 1) '如果检查的内容中没有非法字符
If (strTmp = ".") And (Len(strText) = 1) Then '则判断字符串的第一位是否为小数点
MsgBox strPrompt & "的数值不能只有小数点！", vbOKOnly + vbExclamation, strTitle
blnCheckInput = False
Exit Function
End If
blnCheckInput = True '检查内容合法，则返回检查标志：TRUE
End Function
FBNknEEf.zip