[求助]VBA在CAD中写入文字的程序修改

jiangzl

请各位帮忙看看下面这段简单代码，为什么运行不了啊?运行时说是:当前CAD窗口未显示

Private Sub cmdadd_Click()
For n = 0 To (List1.ListCount - 1)
If List1.Selected(n) = True Then
Text1.Text = Text1.Text & vbCrLf & List1.List(n)
End If
Next
End Sub

Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub Cmdopen_Click()
List1.Clear
CommonDialog1.FONTNAME = ""
CommonDialog1.Flags = 512
CommonDialog1.InitDir = "C:\字库文件"
CommonDialog1.Filter = "Text(*.Txt)|*.txt"
CommonDialog1.ShowOpen
If CommonDialog1.FileName > "" Then
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
Line Input #1, Mydata
List1.AddItem Mydata
Loop
Close #1
End If
End Sub

(出差就在下面这段里)
Private Sub cmdwrite_Click()
Dim WordObj As AcadMText
Dim startPnt As Variant
Dim EndPnt As Variant
startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")
EndPnt = ThisDrawing.Utility.GetPoint(startPnt, vbCrLf & "输入止点:")
Set WordObj = ThisDrawing.ModelSpace.AddMText(startPnt, EndPnt, Text1.Text)
ThisDrawing.Application.ZoomAll
End Sub

多谢，多谢...

mikewolf2k

startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")
前面加一句:

activedocument.show

jiangzl

谢谢mikewolf2k的回答,但还是不行啊,我试了一下,你加的这段处显时:对象不支持该属性或方法.小弟是菜鸟,请各位帮忙再看看...

Private Sub cmdadd_Click()
For n = 0 To (List1.ListCount - 1)
If List1.Selected(n) = True Then
Text1.Text = Text1.Text & vbCrLf & List1.List(n)
End If
Next
End Sub

Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub Cmdopen_Click()
List1.Clear
CommonDialog1.FONTNAME = ""
CommonDialog1.Flags = 512
CommonDialog1.InitDir = "C:\字库文件"
CommonDialog1.Filter = "Text(*.Txt)|*.txt"
CommonDialog1.ShowOpen
If CommonDialog1.FileName > "" Then
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
Line Input #1, Mydata
List1.AddItem Mydata
Loop
Close #1
End If
End Sub
Private Sub cmdwrite_Click()
Dim WordObj As AcadMText
Dim startPnt As Variant
Dim EndPnt As Variant
ActiveDocument.Show
startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")
EndPnt = ThisDrawing.Utility.GetPoint(startPnt, vbCrLf & "输入止点:")
Set WordObj = ThisDrawing.ModelSpace.AddMText(startPnt, EndPnt, Text1.Text)
ThisDrawing.Application.ZoomAll
End Sub

 

雪山飞狐_lzh

前面加

me.hide

后面加

me.show

jiangzl

谢谢两位的指导,但小弟我确实太菜了,做了还是不理想,我将其发上来,大家看看,有空的朋友,帮我再修一下.主要存在下面问题:

1\点"写入"按键时,应该将窗体隐藏,到CAD窗口中去获插入点及宽度,当获取到数据后自动将TEXT1.TXET写入CAD界面,然后再回到窗体上,再次显示对话框.我不知道如何隐藏对话框,和再次让它出现.

2\运行时,当对话框加载时,自动获得"C:/ZK/121.txt"文件,并将文件内容付给List1.list.

再次请求各位帮忙修改一下....谢谢!

bland

Private Sub cmdwrite_Click()
'Me.Show
Dim WordObj As AcadMText
Dim startPnt As Variant
Dim EndPnt As Variant
Me.Hide
startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")
EndPnt = ThisDrawing.Utility.GetDistance(startPnt, vbCrLf & "输入文字宽度:")
Set WordObj = ThisDrawing.ModelSpace.AddMText(startPnt, EndPnt, Text1.Text)
ThisDrawing.Application.ZoomAll
 Me.Show
End Sub

jiangzl

谢谢,成功了!非常感谢谢各位的帮助...

ZOYSIA

jiangzl能否把你的完整程序给我一份，我也正需要这样一个功能，但是我不会写程序。谢谢了。

jiangzl

好的,发给大家看看吧...注意,有一个密码,为750523.多谢各位的帮忙!

解压后,请解"字库文件"文件夹解压到C:下面,加载后在宏里面运行即可.