明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: njcknfy

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

    [复制链接]
发表于 2005-6-6 17:39 | 显示全部楼层

能不能写成VBA程序

感谢楼主写了这个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
发表于 2005-6-15 22:51 | 显示全部楼层
应该帖到vba版块里呀
发表于 2005-7-15 18:41 | 显示全部楼层

佩服!佩服

 楼主| 发表于 2005-7-17 15:50 | 显示全部楼层
介绍一个数字地球的在线浏览软件,真是大开眼界啊,程序是:googleearth.exe可以在google里去搜索,真是不看不知道,如果你是搞测量和GIS的,保证让你看后有很多感触

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2005-7-17 15:59 | 显示全部楼层

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2005-9-6 13:13 | 显示全部楼层

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

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

发表于 2005-9-6 13:16 | 显示全部楼层

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

我的邮箱dwjb0308@163.COM

 楼主| 发表于 2005-9-12 20:33 | 显示全部楼层
试了一下,好像没有对象特征的对话框会找不到的现象,可否发个图片上来看看
发表于 2005-9-13 23:09 | 显示全部楼层
njcknfy 南方分院的林海 厉害!!
发表于 2005-9-23 11:22 | 显示全部楼层
cass中的坎毛经常不见要用REGEN,能不能使它不出现这个现象,或用一个小程序改进它
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 09:37 , Processed in 0.156293 second(s), 17 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表