自己动手,改进CASS中欠缺的功能

poly168

感谢楼主写了这个LISP展点程序，可惜我的LISP学得不好。有那个编程技术好的，能不能将这个展点程序用VBA重写一下。我自已写了一个，可是展上去的点没办法写上扩展属性，不能让CASS识别。我的原程序如下，请各位高手指点： Sub zgcd()
Dim pn As Variant
Dim pnt(0 To 2) As Double
Dim blockRefObj As AcadBlockReference
Dim textObj As AcadText
Dim dh As String
Dim x As Double
Dim y As Double
Dim z As Double
Dim pcode As String
Dim ly As AcadLayer
UserForm4.Show
Dim texth As Double
Set ly = ThisDrawing.Layers.Add("高程")
ly.color = acGreen
Set ly = ThisDrawing.Layers.Add("点号")
ly.color = acMagenta
Set ly = ThisDrawing.Layers.Add("GCD")
ly.color = acRed
UserForm1.CommonDialog1.Filter = "All Files|*.*|*.dat|*.dat|"
UserForm1.CommonDialog1.FilterIndex = 2
UserForm1.CommonDialog1.DefaultExt = ".dat"
UserForm1.CommonDialog1.Action = 1
fl1 = UserForm1.CommonDialog1.FileName
If fl1 = "" Then Exit Sub
Open fl1 For Input As #1
Line Input #1, dh
I = InStr(1, dh, ",")
If I > 0 Then
Close #1
Open fl1 For Input As #1
End If
I = 0
Do While Not EOF(1)
On Error GoTo ex1
Input #1, dh, pcode, x, y, z
pnt(0) = x
pnt(1) = y
pnt(2) = z
If pnt(0) * pnt(1) * pnt(2) <> 0 Then
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pnt, "GC200", 0.1, 0.1, 1#, 0)
blockRefObj.Layer = "GCD"
blockRefObj.color = acByLayer '这里应该写点什么才能将点的SOUTH属性设成202101 Set textObj = ThisDrawing.ModelSpace.AddText(pnt(2), pnt, 0.2)
textObj.Layer = "高程"
textObj.color = acByLayer

pnt(0) = pnt(0) - Len(dh) * 0.2
Set textObj = ThisDrawing.ModelSpace.AddText(dh, pnt, 0.2)
textObj.Layer = "点号"
textObj.color = acByLayer

I = I + 1
End If
Loop
ThisDrawing.Utility.prompt ("共展高程点：" & Str(I) & "个" & Chr$(13) + Chr$(10))
Close #1
ex1:
ThisDrawing.Application.ZoomExtents
End Sub

LONGXIN

应该帖到vba版块里呀

xzf1977

佩服！佩服

njcknfy

介绍一个数字地球的在线浏览软件，真是大开眼界啊，程序是：googleearth.exe可以在google里去搜索，真是不看不知道，如果你是搞测量和GIS的，保证让你看后有很多感触

njcknfy

看看人家美国的GIS数字城市模型，找找差距吧，同志们，咱们在技术上太落后了。

dwjb

对象特性对话筐用鼠标拉倒屏幕最下方后，再也找不到了，输命令不出来

怎么办？有好方法吗？我重新装了一次，我用的cad2002+cass5。1

dwjb

做个可以自动做点之记的功能，就合标准分幅一样，自动加载图廓

我的邮箱dwjb0308@163.COM

njcknfy

试了一下，好像没有对象特征的对话框会找不到的现象，可否发个图片上来看看

wei209

njcknfy 南方分院的林海　厉害！！

hnzzhgy

cass中的坎毛经常不见要用REGEN,能不能使它不出现这个现象,或用一个小程序改进它