乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 76|回复: 5

[求助]下面的程序总是提示有错

[复制链接]

3

主题

17

帖子

1

银币

初来乍到

Rank: 1

铜币
29
发表于 2004-11-25 18:16:00 | 显示全部楼层 |阅读模式

rib2k0idavf.jpg

rib2k0idavf.jpg


如图所示,处理四边形没有问题,如果处理的是如图所示的六边形,总是提示出错了
Sub tt()
                         Dim pnt
                         Dim picked As Boolean
                         Dim px() As Double
                         Dim py() As Double
                         Dim i, k, j As Integer
                         Dim pcenter() As Double
                         Dim insertdistance() As Double
                 Do While 1
                                                         pnt = ThisDrawing.Utility.GetPoint(, "在闭合圈内点击")
                                                         ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & pnt(0) & "," & pnt(1) & vbCr & vbCr
                                                         Set pr = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
                                                         Dim retCoord As Variant
                                                         retCoord = pr.Coordinates
                                                         k = (UBound(retCoord) + 1) / 2
                                                         ReDim px(UBound(retCoord)) As Double
                                                         ReDim py(UBound(retCoord)) As Double
                                                         For i = 0 To UBound(retCoord) Step 2
                                                                                         px(i / 2) = retCoord(i)
                                                                                         py(i / 2) = retCoord(i + 1)
                                                         Next i
                                                         
                                                         ReDim pcenter(k - 2) As Double
                                                         ReDim insertdistance(k - 2) As Double
                                                         For i = 0 To k - 2
                                                                                         pcenter(0) = (px(i) + px(i + 1)) / 2
                                                                                         pcenter(1) = (py(i) + py(i + 1)) / 2
                                                                                         insertdistance(i) = Sqr((px(i) - px(i + 1)) * (px(i) - px(i + 1)) + (py(i) - py(i + 1)) * (py(i) - py(i + 1)))
                                                                                         insertdistance(i) = Format(insertdistance(i), "#,##0.00;;;Nil")
                                                                                         ThisDrawing.ModelSpace.AddText insertdistance(i), pcenter, 0.65
                                                         Next i
                                                 
                         picked = True
                         
Loop
End Sub
回复

使用道具 举报

25

主题

134

帖子

6

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
234
发表于 2004-11-25 19:22:00 | 显示全部楼层
问题在于ReDim pcenter(k - 2) As Double
当是6边行时,ThisDrawing.ModelSpace.AddText insertdistance(i), pcenter, 0.65
中 pcenter含5个数,而坐标为3个double数元
回复

使用道具 举报

3

主题

17

帖子

1

银币

初来乍到

Rank: 1

铜币
29
发表于 2004-11-25 19:46:00 | 显示全部楼层
我个人认为:如果定义为
ReDim pcenter(1) As Double
那就没有问题了
i 增加一个值,都对pcenter(0),pcenter(1)重新赋值。
但事实上程序仍然出错的。
能帮我想个办法,解决这个问题,,要能同时解决上述两种图形的情况。谢啦
回复

使用道具 举报

25

主题

134

帖子

6

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
234
发表于 2004-11-26 08:50:00 | 显示全部楼层
下面的程序在AutoCAD MAP 2000上通过
Sub tt()
                         On Error GoTo Err_Control
                         Dim pnt
                         Dim picked As Boolean
                         Dim px() As Double
                         Dim py() As Double
                         Dim i, k, j As Integer
                         Dim pcenter() As Double
                         Dim insertdistance() As Double
                 Do While 1
                                                         pnt = ThisDrawing.Utility.GetPoint(, "在闭合圈内点击")
                                                         ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & pnt(0) & "," & pnt(1) & vbCr & vbCr
                                                         Set pr = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
                                                         Dim retCoord As Variant
                                                         retCoord = pr.Coordinates
                                                         k = (UBound(retCoord) + 1) / 2
                                                         ReDim px(UBound(retCoord)) As Double
                                                         ReDim py(UBound(retCoord)) As Double
                                                         For i = 0 To UBound(retCoord) Step 2
                                                                                         px(i / 2) = retCoord(i)
                                                                                         py(i / 2) = retCoord(i + 1)
                                                         Next i
                                                         
                                                         ReDim pcenter(0 To 2) As Double
                                                         ReDim insertdistance(k - 2) As Double
                                                         For i = 0 To k - 2
                                                                                         pcenter(0) = (px(i) + px(i + 1)) / 2
                                                                                         pcenter(1) = (py(i) + py(i + 1)) / 2
                                                                                         pcenter(2) = 0
                                                                                         insertdistance(i) = Sqr((px(i) - px(i + 1)) * (px(i) - px(i + 1)) + (py(i) - py(i + 1)) * (py(i) - py(i + 1)))
                                                                                         insertdistance(i) = Format(insertdistance(i), "#,##0.00;;;Nil")
                                                                                         ThisDrawing.ModelSpace.AddText insertdistance(i), pcenter, 0.65
                                                         Next i
                                                 
                         picked = True
                         
Loop
Exit_Here:
         Exit Sub
Err_Control:
         Select Case Err.Number
                                                         Case -2147467259
                                                                 '右键单击或回车或空格
                                                         Err.Clear
                                                         Resume Exit_Here
         End Select
         
End Sub
回复

使用道具 举报

14

主题

48

帖子

4

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
104
发表于 2004-11-26 12:50:00 | 显示全部楼层
楼上的两位版主给我很大启发
回复

使用道具 举报

3

主题

17

帖子

1

银币

初来乍到

Rank: 1

铜币
29
发表于 2004-11-26 21:06:00 | 显示全部楼层
yulijin608非常感谢
我看到上面得到的px,py明显是个二维点,所以下面就将插入点也当成是二维的处理了。
奇怪的是pcenter是三维的。二维的居然不通过,很是纳闷啊。
不过问题是解决了。
谢谢
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-16 13:49 , Processed in 3.056478 second(s), 68 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表