乐筑天下

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

选择外圆DWGeditor帮助

[复制链接]

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2010-1-15 14:54:51 | 显示全部楼层 |阅读模式
我有一个矩形阵列的点,我想修改 我想擦除位于圆形区域之外的点 如果要手动执行,我只需使用erase命令并选择外圈选项,但无法理解如何在VBA中执行此操作 我假设需要使用类型为vicSelectionSetOutsideCircle的选择方法创建一个要删除的点的选择集,但我没有'我不理解如何调用该类型 有人能给我解释一下它的语法吗?
回复

使用道具 举报

0

主题

11

帖子

5

银币

初来乍到

Rank: 1

铜币
12
发表于 2010-1-16 20:36:01 | 显示全部楼层
 如果该点距离圆心的距离大于半径,则将其删除,
,欢迎使用
回复

使用道具 举报

0

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
7
发表于 2010-1-17 07:12:40 | 显示全部楼层

正如布莱科所说:
  1. Option Explicit
  2. Sub DelOutSide()
  3.     Dim oSSet As AcadSelectionSet
  4.     Dim delSet As AcadSelectionSet
  5.     Dim oEnt As AcadEntity
  6.     Dim oCircle As AcadCircle
  7.     Dim oPoint As AcadPoint
  8.     Dim cp As Variant
  9.     Dim varp As Variant
  10.     Dim rad As Double
  11.     Dim ftype(0) As Integer
  12.     Dim fdata(0) As Variant
  13.     Dim dxfCode, dxfValue
  14.     Dim name As String
  15.     Dim count As Integer
  16.     On Error GoTo Err_Control
  17.     With ThisDrawing.SelectionSets
  18.         While .count > 0
  19.             .Item(0).Delete
  20.         Wend
  21.         Set oSSet = .Add("$Points$")
  22.         Set delSet = .Add("$Delete$")
  23.     End With
  24.     ftype(0) = 0: fdata(0) = "POINT"
  25.     dxfCode = ftype: dxfValue = fdata
  26.     ThisDrawing.Utility.GetEntity oEnt, varp, vbLf & "Select circle:"
  27.     If Not TypeOf oEnt Is AcadCircle Then
  28.         Exit Sub
  29.     End If
  30.     Set oCircle = oEnt
  31.     cp = oCircle.Center
  32.     rad = oCircle.Radius
  33.     oSSet.SelectOnScreen dxfCode, dxfValue
  34.     For Each oEnt In oSSet
  35.         Set oPoint = oEnt
  36.         varp = oPoint.Coordinates
  37.         If Distance(varp, cp) > rad Then
  38.             Dim varobj(0) As AcadEntity
  39.             Set varobj(0) = oEnt
  40.             delSet.AddItems (varobj)
  41.         End If
  42.     Next
  43.     MsgBox delSet.count
  44.     delSet.Erase
  45. Exit_Here:
  46.     Exit Sub
  47. Err_Control:
  48.     If Err.Number  0 Then
  49.         MsgBox Err.Description
  50.         Err.Clear
  51.     End If
  52.     Resume Exit_Here
  53. End Sub
  54. '' by Frank Oquendo
  55. Public Function Distance(fPoint As Variant, sPoint As Variant) As Double
  56.     Dim x1 As Double, x2 As Double
  57.     Dim y1 As Double, y2 As Double
  58.     Dim z1 As Double, z2 As Double
  59.     Dim cDist As Double
  60.     x1 = fPoint(0): y1 = fPoint(1): z1 = fPoint(2)
  61.     x2 = sPoint(0): y2 = sPoint(1): z2 = sPoint(2)
  62.     cDist = Sqr(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2) + ((z2 - z1) ^ 2))
  63.     Distance = cDist
  64. End Function

~&039;J#039~
回复

使用道具 举报

0

主题

9

帖子

5

银币

初来乍到

Rank: 1

铜币
10
发表于 2010-1-18 10:16:25 | 显示全部楼层
谢谢你的帮助 
回复

使用道具 举报

0

主题

8

帖子

6

银币

初来乍到

Rank: 1

铜币
8
发表于 2010-1-18 17:39:52 | 显示全部楼层
很高兴帮助大家,干杯;J#039~
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-1 20:26 , Processed in 0.475812 second(s), 63 queries .

© 2020-2025 乐筑天下

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