求多边形重心VB程序源代码

求多边形重心VB程序源代码 VERSION 5.00 Begin VB.Form Form1 Caption = "多边形求重心v1.0 刘海平20120301" ClientHeight = 7230 ClientLeft = 60 ClientTop = 345 ClientWidth = 9240 LinkTopic = "Form1" ScaleHeight = 7230 ScaleWidth = 9240 StartUpPosition = 3 '窗口缺省 Begin VB.CommandButton Command1 Caption = "运行" BeginProperty Font Name = "宋体" Size = 36 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1215 Left = 6720 TabIndex = 13 Top = 3840 Width = 1695 End Begin VB.TextBox Text7 Height = 495 Left = 1800 TabIndex = 12 Text = "3dxyh.scr" Top = 6120 Width = 2055 End Begin VB.TextBox Text6 Height = 495 Left = 4080 TabIndex = 10 Text = "Text6" Top = 5160 Width = 1935 End Begin VB.TextBox Text5 Height = 495 Left = 1800 TabIndex = 9 Text = "Text5" Top = 5160 Width = 2055 End Begin VB.TextBox Text4 Height = 495 Left = 4080 TabIndex = 7 Text = "Text4" Top = 4320 Width = 1935 End Begin VB.TextBox Text3 Height = 495 Left = 1800 TabIndex = 6 Text = "Text3" Top = 4320 Width = 2055 End Begin VB.TextBox Text2 Height = 375 Left = 6480 TabIndex = 4 Text = "2" Top = 600 Width = 1335 End Begin VB.PictureBox Picture1 Height = 2895 Left = 600 Picture = "多边形重心.frx":0000 ScaleHeight = 2835 ScaleWidth = 5355 TabIndex = 2 Top = 1200 Width = 5415 End Begin VB.TextBox Text1 Height = 375 Left = 1440 TabIndex = 1 Text = "3dxyh.csv" Top = 600 Width = 1455 End Begin VB.Label Label5 Caption = "输出CAD运行脚本文件" Height = 375 Left = 360 TabIndex = 11 Top = 6120 Width = 1335 End Begin VB.Label Label4 Caption = "多边形重心" Height = 255 Left = 360 TabIndex = 8 Top = 5280 Width = 1095 End Begin VB.Label Label3 Caption = "坐标平均值" Height = 255 Left = 360 TabIndex = 5 Top = 4440 Width = 1215 End Begin VB.Label Label2 Caption = "输入文件头注释行数" Height = 375 Left = 4560 TabIndex = 3 Top = 600 Width = 1695 End Begin VB.Label Label1 Caption = "输入文件" Height = 255 Left = 600 TabIndex = 0 Top = 600 Width = 975 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub Command1_Click() Dim dname(10000) As String * 16, X(10000) As Double, Y(10000) As Double, H(10000) As Double, ANG(10000) As Double len_fhead = Val(Text2.Text) Open Text1.Text For Input As #1 Open Text7.Text For Output As #2 For i = 1 To len_fhead Line Input #1, aaaa$ Next i '读入数据求平均值并展点标注 i = 0: Xp = 0: Yp = 0 Do Input #1, dname(i), Y(i), X(i), H(i) Print #2, "point " + Trim(Str$(X(i))) + ","; Trim(Str$(Y(i))) Print #2, "text " + Trim(Str$(X(i))) + ","; Trim(Str$(Y(i))) + " " + dname(i) Xp = Xp + X(i) Yp = Yp + Y(i) i = i + 1 Loop Until EOF(1) n = i Print n Xp = Xp / n: Yp = Yp / n '进行平移各点和计算各点对应向量的角度 For i = 0 To n - 1 Y(i) = Y(i) - Yp X(i) = X(i) - Xp If X(i) >= 0 Then ANG(i) = Atn(Y(i) / X(i)) * 180 / 3.14159265358979 Else ANG(i) = 180 + Atn(Y(i) / X(i)) * 180 / 3.14159265358979 End If Next i '按角度把各点排序 For i = 0 To n - 2 For j = i + 1 To n - 1 If ANG(i) > ANG(j) Then NTEM$ = dname(i): XMIN = X(i): YMIN = Y(i): HMIN = H(i): AMIN = ANG(i) dname(i) = dname(j): X(i) = X(j): Y(i) = Y(j): H(i) = H(j): ANG(i) = ANG(j) dname(j) = NTEM$: X(j) = XMIN: Y(j) = YMIN: H(j) = HMIN: ANG(j) = AMIN End If Next j Next i '计算N个小三角形面积和重心并展平均和重心点标注 area = 0#: cenx = 0#: ceny = 0# For i = 0 To n - 1 If i = n - 1 Then t = 0 Else t = i + 1 T_area = X(i + 1) * Y(i) - Y(i + 1) * X(i) area = area + T_area * 0.5 cenx = cenx + T_area * (X(i) + X(i + 1)) / 6# ceny = ceny + T_area * (Y(i) + Y(i + 1)) / 6# Next i cenx = cenx / area ceny = ceny / area Text3.Text = Format(Yp, "#######0.000"): Text4.Text = Format(Xp, "#######0.000") Text5.Text = Format(Yp + ceny, "#######0.000"): Text6.Text = Format(Xp + cenx, "#######0.000") Print #2, "point " + Trim(Str$(Xp)) + ","; Trim(Str$(Yp)) Print #2, "text " + Trim(Str$(Xp)) + ","; Trim(Str$(Yp)) + " " + "Average" Print #2, "point " + Trim(Str$(Xp + cenx)) + ","; Trim(Str$(Yp + ceny)) Print #2, "text " + Trim(Str$(Xp + cenx)) + ","; Trim(Str$(Yp + ceny)) + " " + "Center" Close End Sub