乐筑天下

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

检查了好多遍都没有问题,可运行就是不行!

[复制链接]
gzy

25

主题

1118

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1221
发表于 2004-4-27 20:10:00 | 显示全部楼层 |阅读模式
程序的目的是将3D多段线的所有节点的Z坐标去掉,然后生成一2D多段线。思路应该没有问题,可老提示坐标越界。哪位帮我看看到底是怎么回事。   用下面这个图形做测试。
  1. Sub test3Dto2D()
  2. '创建选择集
  3. Dim selset As AcadSelectionSet
  4. Dim cor3 As Variant
  5. Dim n As Integer
  6. Dim a As Integer
  7. a = 0
  8. Set selset = ThisDrawing.SelectionSets.Add("sset")
  9. selset.Select acSelectionSetAll         '遍历选择集并将每一个对象镜相
  10. Dim entry As AcadObject
  11. Dim pl As AcadLWPolylineFor Each entry In selset
  12.      If entry.EntityName = "AcDb3dPolyline" Then
  13.                cor3 = entry.Coordinates
  14.                n = (UBound(cor3) + 1) * 2 / 3
  15.                Dim pt() As Double
  16.                ReDim pt(0 To n - 1) As Double                       For i = 0 To (n - 2) Step 2
  17.                                pt(i) = cor3(a)
  18.                                pt(i + 1) = cor3(a + 1)
  19.                                a = a + 3
  20.                        Next i
  21.                        
  22.                Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)
  23.                entry.Delete
  24.        End If
  25. Next entryselset.Delete '避免下次重复End Sub

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

26

主题

177

帖子

7

银币

后起之秀

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

铜币
281
发表于 2004-4-27 20:33:00 | 显示全部楼层
在 entry.Delete后面加上 a=0
回复

使用道具 举报

gzy

25

主题

1118

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1221
发表于 2004-4-27 20:36:00 | 显示全部楼层
嘿嘿!多谢,我太粗心了!
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2004-4-27 20:42:00 | 显示全部楼层
  1. Sub tn = (UBound(cor3) + 1) * 2 / 3
  2.                Dim pt() As Double
  3.                ReDim pt(0 To n - 1) As Double
  4.                        For i = 0 To (n - 2) Step 2
这里太乱了,改为sub test3Dto2D()
'创建选择集
Dim selset As AcadSelectionSet
Dim cor3 As Variant
Dim n As Integer
Set selset = ThisDrawing.SelectionSets.Add("sset")
selset.Select acSelectionSetAll         '遍历选择集并将每一个对象镜相
Dim entry As AcadObject
Dim pl As AcadLWPolylineFor Each entry In selset
     If entry.EntityName = "AcDb3dPolyline" Then
               cor3 = entry.Coordinates
               n = (UBound(cor3) + 1) / 3
               Dim pt() As Double
               ReDim pt(0 To n * 2 - 1) As Double                       For i = 0 To n - 1
                               pt(i * 2) = cor3(i * 3)
                               pt(i * 2 + 1) = cor3(i * 3 + 1)
                       Next i
                       
               Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)
               entry.Delete
       End If
Next entryselset.Delete '避免下次重复End Sub
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-15 16:21 , Processed in 0.392209 second(s), 65 queries .

© 2020-2025 乐筑天下

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