能不能写成VBA程序
感谢楼主写了这个LISP展点程序,可惜我的LISP学得不好。有那个编程技术好的,能不能将这个展点程序用VBA重写一下。我自已写了一个,可是展上去的点没办法写上扩展属性,不能让CASS识别。我的原程序如下,请各位高手指点:Sub zgcd()<BR>Dim pn As Variant<BR>Dim pnt(0 To 2) As Double<BR>Dim blockRefObj As AcadBlockReference<BR>Dim textObj As AcadText<BR>Dim dh As String<BR>Dim x As Double<BR>Dim y As Double<BR>Dim z As Double<BR>Dim pcode As String<BR>Dim ly As AcadLayer<BR>UserForm4.Show<BR>Dim texth As Double
<BR>Set ly = ThisDrawing.Layers.Add("高程")<BR>ly.color = acGreen<BR>Set ly = ThisDrawing.Layers.Add("点号")<BR>ly.color = acMagenta<BR>Set ly = ThisDrawing.Layers.Add("GCD")<BR>ly.color = acRed<BR>UserForm1.CommonDialog1.Filter = "All Files|*.*|*.dat|*.dat|"<BR>UserForm1.CommonDialog1.FilterIndex = 2<BR>UserForm1.CommonDialog1.DefaultExt = ".dat"<BR>UserForm1.CommonDialog1.Action = 1<BR>fl1 = UserForm1.CommonDialog1.FileName<BR>If fl1 = "" Then Exit Sub<BR>Open fl1 For Input As #1<BR>Line Input #1, dh<BR>I = InStr(1, dh, ",")<BR>If I > 0 Then<BR>Close #1 <BR>Open fl1 For Input As #1<BR>End If<BR>I = 0<BR>Do While Not EOF(1)<BR>On Error GoTo ex1<BR>Input #1, dh, pcode, x, y, z<BR>pnt(0) = x<BR>pnt(1) = y<BR>pnt(2) = z<BR>If pnt(0) * pnt(1) * pnt(2) <> 0 Then<BR>Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pnt, "GC200", 0.1, 0.1, 1#, 0)<BR>blockRefObj.Layer = "GCD"<BR>blockRefObj.color = acByLayer
'这里应该写点什么才能将点的SOUTH属性设成202101
Set textObj = ThisDrawing.ModelSpace.AddText(pnt(2), pnt, 0.2)<BR>textObj.Layer = "高程"<BR>textObj.color = acByLayer<BR><BR>pnt(0) = pnt(0) - Len(dh) * 0.2<BR>Set textObj = ThisDrawing.ModelSpace.AddText(dh, pnt, 0.2)<BR>textObj.Layer = "点号"<BR>textObj.color = acByLayer<BR><BR>I = I + 1<BR>End If<BR>Loop<BR>ThisDrawing.Utility.prompt ("共展高程点:" & Str(I) & "个" & Chr$(13) + Chr$(10))<BR>Close #1<BR>ex1:<BR>ThisDrawing.Application.ZoomExtents<BR>End Sub<BR> 应该帖到vba版块里呀 <P>佩服!佩服</P> 介绍一个数字地球的在线浏览软件,真是大开眼界啊,程序是:googleearth.exe可以在google里去搜索,真是不看不知道,如果你是搞测量和GIS的,保证让你看后有很多感触 <P>看看人家美国的GIS数字城市模型,找找差距吧,同志们,咱们在技术上太落后了。</P> <P>对象特性对话筐用鼠标拉倒屏幕最下方后,再也找不到了,输命令不出来</P>
<P>怎么办?有好方法吗?我重新装了一次,我用的cad2002+cass5。1</P> <P>做个可以自动做点之记的功能,就合标准分幅一样,自动加载图廓</P>
<P>我的邮箱dwjb0308@163.COM</P> 试了一下,好像没有对象特征的对话框会找不到的现象,可否发个图片上来看看 <A name=83463><FONT color=#000066><B>njcknfy</B></FONT></A> 南方分院的林海 厉害!! cass中的坎毛经常不见要用REGEN,能不能使它不出现这个现象,或用一个小程序改进它