[求助]VBA在CAD中写入文字的程序修改
<P>请各位帮忙看看下面这段简单代码，为什么运行不了啊?运行时说是:当前CAD窗口未显示</P><P><BR>Private Sub cmdadd_Click()<BR>For n = 0 To (List1.ListCount - 1)<BR>If List1.Selected(n) = True Then<BR>Text1.Text = Text1.Text & vbCrLf & List1.List(n)<BR>End If<BR>Next<BR>End Sub</P>
<P>Private Sub cmdclose_Click()<BR>Unload Me<BR>End Sub</P>
<P>Private Sub Cmdopen_Click()<BR>List1.Clear<BR>CommonDialog1.FONTNAME = ""<BR>CommonDialog1.Flags = 512<BR>CommonDialog1.InitDir = "C:\字库文件"<BR>CommonDialog1.Filter = "Text(*.Txt)|*.txt"<BR>CommonDialog1.ShowOpen<BR>If CommonDialog1.FileName > "" Then<BR>Open CommonDialog1.FileName For Input As #1<BR>Do While Not EOF(1)<BR>Line Input #1, Mydata<BR>List1.AddItem Mydata<BR>Loop<BR>Close #1<BR>End If<BR>End Sub</P>
<P>(出差就在下面这段里)<BR>Private Sub cmdwrite_Click()<BR>Dim WordObj As AcadMText<BR>Dim startPnt As Variant<BR>Dim EndPnt As Variant<BR>startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")<BR>EndPnt = ThisDrawing.Utility.GetPoint(startPnt, vbCrLf & "输入止点:")<BR>Set WordObj = ThisDrawing.ModelSpace.AddMText(startPnt, EndPnt, Text1.Text)<BR>ThisDrawing.Application.ZoomAll<BR>End Sub</P>
<P>多谢，多谢...</P> <P>startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")<BR>前面加一句:</P>
<P>activedocument.show</P> <P>谢谢mikewolf2k的回答,但还是不行啊,我试了一下,你加的这段处显时:对象不支持该属性或方法.小弟是菜鸟,请各位帮忙再看看...</P>
<P><BR>Private Sub cmdadd_Click()<BR>For n = 0 To (List1.ListCount - 1)<BR>If List1.Selected(n) = True Then<BR>Text1.Text = Text1.Text & vbCrLf & List1.List(n)<BR>End If<BR>Next<BR>End Sub</P>
<P>Private Sub cmdclose_Click()<BR>Unload Me<BR>End Sub</P>
<P>Private Sub Cmdopen_Click()<BR>List1.Clear<BR>CommonDialog1.FONTNAME = ""<BR>CommonDialog1.Flags = 512<BR>CommonDialog1.InitDir = "C:\字库文件"<BR>CommonDialog1.Filter = "Text(*.Txt)|*.txt"<BR>CommonDialog1.ShowOpen<BR>If CommonDialog1.FileName > "" Then<BR>Open CommonDialog1.FileName For Input As #1<BR>Do While Not EOF(1)<BR>Line Input #1, Mydata<BR>List1.AddItem Mydata<BR>Loop<BR>Close #1<BR>End If<BR>End Sub<BR>Private Sub cmdwrite_Click()<BR>Dim WordObj As AcadMText<BR>Dim startPnt As Variant<BR>Dim EndPnt As Variant<BR>ActiveDocument.Show<BR>startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")<BR>EndPnt = ThisDrawing.Utility.GetPoint(startPnt, vbCrLf & "输入止点:")<BR>Set WordObj = ThisDrawing.ModelSpace.AddMText(startPnt, EndPnt, Text1.Text)<BR>ThisDrawing.Application.ZoomAll<BR>End Sub</P>
<P> </P> <P>前面加</P>
<P>me.hide</P>
<P>后面加</P>
<P>me.show</P> <P>谢谢两位的指导,但小弟我确实太菜了,做了还是不理想,我将其发上来,大家看看,有空的朋友,帮我再修一下.主要存在下面问题:</P>
<P>1\点"写入"按键时,应该将窗体隐藏,到CAD窗口中去获插入点及宽度,当获取到数据后自动将TEXT1.TXET写入CAD界面,然后再回到窗体上,再次显示对话框.我不知道如何隐藏对话框,和再次让它出现.</P>
<P>2\运行时,当对话框加载时,自动获得"C:/ZK/121.txt"文件,并将文件内容付给List1.list.</P>
<P>再次请求各位帮忙修改一下....谢谢!</P> Private Sub cmdwrite_Click()<BR>'Me.Show<BR>Dim WordObj As AcadMText<BR>Dim startPnt As Variant<BR>Dim EndPnt As Variant<BR>Me.Hide<BR>startPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入起点:")<BR>EndPnt = ThisDrawing.Utility.GetDistance(startPnt, vbCrLf & "输入文字宽度:")<BR>Set WordObj = ThisDrawing.ModelSpace.AddMText(startPnt, EndPnt, Text1.Text)<BR>ThisDrawing.Application.ZoomAll<BR> Me.Show<BR>End Sub<BR> 谢谢,成功了!非常感谢谢各位的帮助... <P>jiangzl能否把你的完整程序给我一份，我也正需要这样一个功能，但是我不会写程序。谢谢了。</P> <P>好的,发给大家看看吧...注意,有一个密码,为750523.多谢各位的帮忙!</P>
<P>解压后,请解"字库文件"文件夹解压到C:下面,加载后在宏里面运行即可.</P>
页:
[1]