截面特性计算软件使用方法 [复制链接]

我的用“TX”不行。怎么回事？

分别加载安装目录下的两个文件: 1.截面计算.dvb 2.截面计算.lsp 一定都得加上,否则不能运行.请查正一下是否加载.

我下载了您们的关于截面特性的补丁，非常有用！感谢您们编写了这么好的小东东！我在用的时候发现在编写时可能没有注意方向，我将截面旋转一个方向，Ix和Iy数值均没变。这与截面特性可不一样。所以向您们提出这个问题，不知是否正确？ 我联系EMAIL：YHJ.NET@SOHU.COM msn:yhj_net@hotmail.com

以下是引用yhj.net在2004-8-21 16:45:15的发言： 我下载了您们的关于截面特性的补丁，非常有用！感谢您们编写了这么好的小东东！我在用的时候发现在编写时可能没有注意方向，我将截面旋转一个方向，Ix和Iy数值均没变。这与截面特性可不一样。所以向您们提出这个问题，不知是否正确？ 我联系EMAIL：YHJ.NET@SOHU.COM msn:yhj_net@hotmail.com

谢谢您的关注,确实有这个Bug,我们正设法改进,并尽快将改进后的版本发布!

补丁在哪里,我怎么不知道啊

我用的时候老是出现编译错误,子程序或函数未定义,怎么回事,我用的是2000

怎么没人回答我啊???昏

以下是我运行后的结果,我的系统是XP

Sub test() Dim XcSel As AcadRegion Dim RegionSet As AcadSelectionSet  '建立选择集并从屏幕选取 Dim FilterType(0) As Integer  '过滤，仅让面域可选 Dim FilterData(0) As Variant

On Error Resume Next ThisDrawing.SelectionSets("R0").Delete Set RegionSet = ThisDrawing.SelectionSets.Add("R0") FilterType(0) = 0 FilterData(0) = "region" RegionSet.SelectOnScreen FilterType, FilterData

If RegionSet.Count = 0 Then     MsgBox "没有选择面域!请选择后重试!", vbExclamation + vbOKOnly, "系统提示"     Exit Sub End If If RegionSet.Count > 1 Then     MsgBox "所选面域大于1个!进行计算的面域只能为1,否则会出错,请重新选择!", vbExclamation + vbOKOnly, "系统提示"     Exit Sub End If Set XcSel = RegionSet.Item(0) '调用计算过程 Call Xcdm(ThisDrawing, XcSel) End Sub

Public Sub Xcdm(ByVal SelDoc As AcadDocument, Xc As AcadRegion) Dim MoveFrom(2) As Double Dim MoveTo(2) As Double Dim MinPo As Variant, MaxPo As Variant Dim Ix As Double, Iy As Double Dim X1 As Double, X2 As Double, Y1 As Double, Y2 As Double Dim Point(7) As Double Dim LWPLine(0) As AcadLWPolyline Dim NewReg As AcadRegion, BoolVar As Variant, BoolReg As Variant Dim Xctx As String '定义上部参数 Dim S_top As Double, Y_top As Double '定义下部参数 Dim S_button As Double, Y_button As Double '定义左部参数 Dim S_left As Double, X_left As Double '定义右部参数 Dim S_right As Double, X_right As Double

'将质心移到原点 MoveFrom(0) = Xc.Centroid(0): MoveFrom(1) = Xc.Centroid(1): MoveFrom(2) = 0 MoveTo(0) = 0: MoveTo(1) = 0: MoveTo(2) = 0 Xc.Move MoveFrom, MoveTo '算出外框最左下角及右上角 Xc.GetBoundingBox MinPo, MaxPo '取出各轴惯性矩 Ix = Xc.PrincipalMoments(1) Iy = Xc.PrincipalMoments(0) '取出各边界值 X1 = Abs(MaxPo(0)): X2 = Abs(MinPo(0)) Y1 = Abs(MaxPo(1)): Y2 = Abs(MinPo(1))

'求出上部面域参数 Point(0) = MinPo(0) - 10: Point(1) = 0 Point(2) = MaxPo(0) + 10: Point(3) = 0 Point(4) = MaxPo(0) + 10: Point(5) = MinPo(1) - 10 Point(6) = MinPo(0) - 10: Point(7) = MinPo(1) - 10 Set LWPLine(0) = SelDoc.ModelSpace.AddLightWeightPolyline(Point) LWPLine(0).Closed = True BoolVar = SelDoc.ModelSpace.AddRegion(LWPLine) LWPLine(0).Delete Set BoolReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) Set NewReg = Xc.Copy NewReg.Boolean acSubtraction, BoolReg Set NewReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) S_top = NewReg.Area Y_top = Abs(NewReg.Centroid(1)) NewReg.Delete

'求出下部面域参数 Point(0) = MinPo(0) - 10: Point(1) = 0 Point(2) = MaxPo(0) + 10: Point(3) = 0 Point(4) = MaxPo(0) + 10: Point(5) = MaxPo(1) + 10 Point(6) = MinPo(0) - 10: Point(7) = MaxPo(1) + 10 Set LWPLine(0) = SelDoc.ModelSpace.AddLightWeightPolyline(Point) LWPLine(0).Closed = True BoolVar = SelDoc.ModelSpace.AddRegion(LWPLine) LWPLine(0).Delete Set BoolReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) Set NewReg = Xc.Copy NewReg.Boolean acSubtraction, BoolReg Set NewReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) S_button = NewReg.Area Y_button = Abs(NewReg.Centroid(1)) NewReg.Delete

'求出左部面域参数 Point(0) = 0: Point(1) = MinPo(1) - 10 Point(2) = MaxPo(0) + 10: Point(3) = MinPo(1) - 10 Point(4) = MaxPo(0) + 10: Point(5) = MaxPo(1) + 10 Point(6) = 0: Point(7) = MaxPo(1) + 10 Set LWPLine(0) = SelDoc.ModelSpace.AddLightWeightPolyline(Point) LWPLine(0).Closed = True BoolVar = SelDoc.ModelSpace.AddRegion(LWPLine) LWPLine(0).Delete Set BoolReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) Set NewReg = Xc.Copy NewReg.Boolean acSubtraction, BoolReg Set NewReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) S_left = NewReg.Area X_left = Abs(NewReg.Centroid(0)) NewReg.Delete

'求出右部面域参数 Point(0) = 0: Point(1) = MinPo(1) - 10 Point(2) = MinPo(0) - 10: Point(3) = MinPo(1) - 10 Point(4) = MinPo(0) - 10: Point(5) = MaxPo(1) + 10 Point(6) = 0: Point(7) = MaxPo(1) + 10 Set LWPLine(0) = SelDoc.ModelSpace.AddLightWeightPolyline(Point) LWPLine(0).Closed = True BoolVar = SelDoc.ModelSpace.AddRegion(LWPLine) LWPLine(0).Delete Set BoolReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) Set NewReg = Xc.Copy NewReg.Boolean acSubtraction, BoolReg Set NewReg = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1) S_right = NewReg.Area X_right = Abs(NewReg.Centroid(0)) NewReg.Delete

'显示结果 Xctx = "当前截面特性如下:" & vbCr & "截面面积:S=" & Round(Xc.Area / 100, 3) & "cm^2" & vbCr & "型材线重:G=" & Round(Xc.Area * 2.7 / 1000, 3) & "Kg/m" _     & vbCr & "X轴惯性矩:Ix=" & Round(Ix / 10000, 3) & "cm^4" & vbCr & "Y轴惯性矩:Iy=" & Round(Iy / 10000, 3) & "cm^4" & vbCr & "X轴抵抗矩一:Wx1=" & Round(Ix / Y1 / 1000, 3) & "cm^3" _     & vbCr & "X轴抵抗矩二:Wx2=" & Round(Ix / Y2 / 1000, 3) & "cm^3" & vbCr & "Y轴抵抗矩一:Wy1=" & Round(Iy / X1 / 1000, 3) & "cm^3" & vbCr & "Y轴抵抗矩二:Wy2=" & Round(Iy / X2 / 1000, 3) & "cm^3" _     & vbCr & "X轴面积矩一:Sx1=" & Round(S_top * Y_top / 1000, 3) & "cm^3" & vbCr & "X轴面积矩二:Sx2=" & Round(S_button * Y_button / 1000, 3) & "cm^3" _     & vbCr & "Y轴面积矩一:Sy1=" & Round(S_left * X_left / 1000, 3) & "cm^3" & vbCr & "Y轴面积矩二:Sy2=" & Round(S_right * X_right / 1000, 3) & "cm^3" MsgBox Xctx & vbCr & vbCr & vbCr & "    谢谢使用截面计算工具,该程序由'豪典设计室'编制,发布," & vbCr & "为免费软件.如须转载,保留版权信息,有什么部题欢迎到我" & vbCr & "们的网站:http://www.hdwall.net提问." _     , vbInformation + vbOKOnly, "运行结果" ZoomAll End Sub

不会吧,源码都出来了,我想是不是因为CAD版本的原因,我是在2004下开发出来的,你用的是2000吧,我没试过建议在2004下试一试.