关于惯性矩计算cad2002中运行正常，2004/5/6中运行出错

wxylzgx

关于惯性矩计算cad2002中运行正常，2004/5/6中运行出错，代码为

Private Sub CommandButton_Click()
UserForm1.Hide

Dim temp(0 To 2) As Double
Dim currUCS As AcadUCS
Dim origin(0 To 2) As Double

Dim Centroid As Variant
Dim momentOflnertia As Variant
Dim sset As AcadSelectionSet 'Define sset as a SelectionSet object
'Set sset to a new selection set namaed SS1 (the name doesn't matter here)
Set sset = ThisDrawing.SelectionSets.Add("SS1")
sset.SelectOnScreen 'Prompt user to selet objects

'save cuurent 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 throught 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

momentOflnertia = ent.momentOflnertia

MsgBox "lx=" & Format(momentOflnetia(0) / 10000, "######.00") & "cm^4: ly=" & Format(momentOflnetia(1) / 10000, "######.00") & "cm^4", , "被选择物体的惯性矩"
currUCS.origin = temp
ThisDrawing.ActiveUCS = currUCS 'restore ActiveUCS origin
End If
Next ent
sset.Delete
UserForm1.Show
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

wxylzgx

第二次运行时出现另一行错误

alin

很多键入错误,主要是momentOfInertia错了

这段程序在2002也不运行正常,问问题应该说实话!

wxylzgx

alin发表于2005-9-29 21:45:00 很多键入错误,主要是momentOfInertia错了 这段程序在2002也不运行正常,问问题应该说实话!

请教alin，可以帮修正一下吗？

我在2002中运行好像没发现什么问题

alin

You should copy your codes in 2002 and paste it here. The spelling the word 'MomentOfInertia' is wrong in your code. It is "I" not "l". Please double check your code. Some "MomentOfInertia" miss an "r" in between.

BTW, try to delete the selection set named "SS1" first before going for another test. A selection set named "SS1" has been left in the drawing database when your routine breaks down. This will cause an error while you try to create another selection set with the same name.

wxylzgx

alin发表于2005-9-30 14:33:00 You should copy your codes in 2002 and paste it here. The spelling the word 'MomentOfInertia' is wrong in your code. It is \"I\" not...

复制代码后还是不行，请alin帮忙看看是什么问题，非常感谢！

Private Sub CommandButton1_Click()
    UserForm1.Hide
   
    Dim temp(0 To 2) As Double
    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
   
    '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") & "cm^4:Iy=" & Format(momentOfInertia(1) / 10000, "######.00") & "cm^4", , "被选择物体的惯性矩"
    currUCS.origin = temp
    ThisDrawing.ActiveUCS = currUCS  'restore ActiveUCS origin
            End If
    Next ent
    sset.Delete
    UserForm1.Show
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub Image1_Click()

End Sub

alin

Try to run UCS command and save an UCS first

wxylzgx

我把dvb文件传上来，alin能否帮看看？

alin

问题应该不在版本，是UCS的问题，凑合用着吧...

 

wxylzgx

alin发表于2005-9-30 21:32:00 问题应该不在版本，是UCS的问题，凑合用着吧... UploadFile/2005-9/200593021322234.rar,viewFile.asp?ID=21818

非常感谢！