乐筑天下

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

我想计算将面域的形心移动到0,0点然后计算惯性矩,可奇次和偶次计算结果不一样

[复制链接]
zzz

1

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
6
发表于 2002-7-13 14:24:00 | 显示全部楼层 |阅读模式
我想计算将面域的形心移动到0,0点然后计算惯性矩,可奇次和偶次计算结果不一样,具体的说就是形心坐标第偶次计算又回到初始的位置:(,程序如下
Private Sub CommandButton1_Click()
    UserForm1.Hide
   
    Dim currUCS As AcadUCS
    Dim origin(0 To 2) As Double
        
    Dim Centroid As Variant
    Dim momentOfInertia As Variant
    Dim sset As AcadSelectionSet         'Define sset as a SelectionSet object
    'Set sset to a new selection set named SS1 (the name doesn't matter here)
    Set sset = ThisDrawing.SelectionSets.Add("SS1")
   
    sset.SelectOnScreen                  'Prompt user to select objects
   
    Dim ent As Object                    'Define ent as an object
    For Each ent In sset                 'Loop through the SelectionSet collection
        If ent.EntityName = "AcDbRegion" Then
            
            Centroid = ent.Centroid
            ' Create a UCS and makes it current
            Set currUCS = ThisDrawing.ActiveUCS
            
            origin(0) = Centroid(0): origin(1) = Centroid(1): origin(2) = 0
            currUCS.origin = origin
            
            ThisDrawing.ActiveUCS = currUCS
            momentOfInertia = ent.momentOfInertia
            MsgBox "Ix=" & Format(momentOfInertia(0) / 10000, "######.00") & "mm^4;Iy=" & Format(momentOfInertia(1) / 10000, "######.00") & "mm^4", , "被选择物体的惯性矩"
            
            End If
    Next ent
    sset.Delete
    UserForm1.Show
End Sub
回复

使用道具 举报

14

主题

230

帖子

5

银币

后起之秀

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

铜币
286
发表于 2002-7-15 12:53:00 | 显示全部楼层
通过单步调试,我发现奇次和偶次计算时,currUCS.origin和ThisDrawing.ActiveUCS.origin不一样,暂未找到解决办法,有空我再试试。
回复

使用道具 举报

zzz

1

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
6
发表于 2002-7-16 14:06:00 | 显示全部楼层
帮我调试调试,我做不出来。
回复

使用道具 举报

14

主题

230

帖子

5

银币

后起之秀

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

铜币
286
发表于 2002-7-16 16:03:00 | 显示全部楼层

找到原因了,Thisdrawing.ActiveUCS是活动UCS而不是系统UCS,计算转动惯量时以Thisdrawing.ActiveUCS的原点为中心,第一次运行时,以面域形心(注意:形心坐标非零,即不是系统UCS原点)为惯性中心;第二次运行时,形心坐标计算以Thisdrawing.ActiveUCS为参照,为零,惯性中心为(0,0)即系统UCS原点与面域形心不同。
解决办法:在修改Thisdrawing.ActiveUCS前保存原点,MsgBox后恢复。请参考以下代码。
Private Sub CommandButton1_Click()
    UserForm1.Hide
    Dim temp(0 To 2) As Double
    Dim origin(0 To 2) As Double
    Dim Centroid As Variant
    Dim currUCS As AcadUCS
    Dim momentOfInertia As Variant
    Dim sset As AcadSelectionSet         'Define sset as a SelectionSet object
    'Set sset to a new selection set named SS1 (the name doesn't matter here)
    Set sset = ThisDrawing.SelectionSets.Add("SS1")
   
    sset.SelectOnScreen                  'Prompt user to select objects
    'save current UCS origin
   temp(0) = ThisDrawing.ActiveUCS.origin(0)
   temp(1) = ThisDrawing.ActiveUCS.origin(1)
   temp(2) = ThisDrawing.ActiveUCS.origin(2)
    Dim ent As Object                    'Define ent as an object
    For Each ent In sset                 'Loop through the SelectionSet collection
        If ent.EntityName = "AcDbRegion" Then
            
            Centroid = ent.Centroid

            ' Create a UCS and makes it current
            Set currUCS = ThisDrawing.ActiveUCS
           
            origin(0) = Centroid(0): origin(1) = Centroid(1): origin(2) = 0
            currUCS.origin = origin
            
            ThisDrawing.ActiveUCS = currUCS

            momentOfInertia = ent.momentOfInertia

            MsgBox "Ix=" & Format(momentOfInertia(0) / 10000, "######.00") & "mm^4;Iy=" & Format(momentOfInertia(1) / 10000, "######.00") & "mm^4", , "被选择物体的惯性矩"
        End If
    Next ent
    currUCS.origin = temp
    ThisDrawing.ActiveUCS = currUCS  'restore ActiveUCS origin
    sset.Delete
    UserForm1.Show
End Sub
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2024-11-22 07:15 , Processed in 0.143094 second(s), 60 queries .

© 2020-2024 乐筑天下

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