乐筑天下

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

[已解决]如何得到选择的多个对象的共同中心点呢?

[复制链接]

16

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
113
发表于 2008-6-5 22:21:00 | 显示全部楼层 |阅读模式
我知道一个函数,给任用一个实体绘制边框,可是如何得到实体的中心点呢?
Public Function DrawBoundingBox(ent As AcadEntity) As AcadLWPolyline
    Dim Min, Max
   
    ent.GetBoundingBox Min, Max
    Set DrawBoundingBox = Rectangle(Min, Max)
End Function
回复

使用道具 举报

16

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
113
发表于 2008-6-5 22:54:00 | 显示全部楼层
得到一个方法,但只能选择1个对象或一个块,同时选择多个对象时想得到中心点还请大家帮帮忙
Public Function GetEntMidPoint(ent As AcadEntity) As Variant '获得对象的中心点
    Dim min, max
    ent.GetBoundingBox min, max
    GetEntMidPoint = Array((min(0) + max(0)) / 2, (min(1) + max(1)) / 2, (min(2) + max(2)) / 2)
End Function
回复

使用道具 举报

16

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
113
发表于 2008-6-10 15:43:00 | 显示全部楼层
已经解决了!思路为先得到每个对象的min max数字,在比较其他对象的min max值,遍历所有对象后得到所有对象的最大值和最小值,从而得到共同的中心点,哈哈感谢乐筑天下。代码如下:
Public xmin(0 To 2) As Double
Public ymax(0 To 2) As Double
Public Function GetEntMaxmin(ent As AcadEntity) As Variant '获得对象的最大值最小值
    Dim min, max
    ent.GetBoundingBox min, max
    xmin(0) = min(0): xmin(1) = min(1): xmin(2) = 0
    ymax(0) = max(0): ymax(1) = max(1): ymax(2) = 0
End Function
Sub dxjzY() '让选择的对象居中
Dim obj() As AcadEntity
Dim ent As AcadEntity
Dim ss As AcadSelectionSet
Dim midd(0 To 2) As Double
Dim mid2(0 To 2) As Double
Dim minmin(0 To 2) As Double
Dim maxmax(0 To 2) As Double
Dim i As Long
Set ss = ThisDrawing.SelectionSets.Add("sss")
ss.SelectOnScreen
ReDim obj(0 To ss.Count - 1) As AcadEntity
For Each ent In ss
    Set obj(i) = ent
    i = i + 1
Next
GetEntMaxmin obj(0)
minmin(0) = xmin(0): minmin(1) = xmin(1): minmin(2) = 0
maxmax(0) = ymax(0): maxmax(1) = ymax(1): maxmax(2) = 0
For i = 1 To ss.Count - 1
   Set obj(i) = ss.Item(i)
   GetEntMaxmin obj(i)
   If minmin(0) > xmin(0) Then minmin(0) = xmin(0)
   If minmin(1) > xmin(1) Then minmin(1) = xmin(1)
   If maxmax(0)
回复

使用道具 举报

15

主题

70

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
130
发表于 2008-6-10 16:16:00 | 显示全部楼层
请LZ关注下
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-4 11:52 , Processed in 1.056613 second(s), 60 queries .

© 2020-2025 乐筑天下

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