万花尺

飞雪神光

mahuan1279 发表于 2024-12-27 21:01
这是干啥用的？

就是写着玩的...

zm880928

只是用来玩的吗，还有没有其他用途呢

tiancao100

2. Private Sub CommandButton2_Click()
   
3.     Dim i As Long
   
4.     Dim n As Integer
   
5.     Dim Pi As Double
   
6.     Pi = 4# * Atn(1#)
   
7.     Dim R As Long
   
8.     Randomize
   
9.     R = Int(Rnd * 100)
   
10.     Dim R1 As Long
    
11.     R1 = (0.5 - Rnd) * 199
    
12.     Dim L As Long
    
13.     L = Int(Rnd * 200)
    
14.     Dim S As Long
    
15.     S = Int(Rnd * 50)
    
16.     Dim M As Long
    
17.     M = Int(Rnd * 100)
    
18.     Dim A1 As Double
    
19.     Dim A2 As Double
    
20.     Dim P(2) As Double
    
21.     Dim P0(2) As Double
    
22.     Dim x As Double
    
23.     Dim y As Double
    
24.    
    
25.     Dim Fit() As Double
    
26.     Dim Sp As AcadSpline
    
27.    
    
28.     ReDim Fit(2)
    
29.    
    
30.     i = i + 1
    
31.     n = n + 1
    
32.     A1 = i * Pi / 180
    
33.     A2 = (R1 / R) * A1
    
34.    
    
35.     x = (-(R1 - R) * Cos(A1) - S * Cos(A2 - A1) + 100) * M
    
36.     y = ((R1 - R) * Sin(A1) - S * Sin(A2 - A1) + 100) * M
    
37.    
    
38.     P0(0) = x: P0(1) = y
    
39.     Fit(0) = x: Fit(1) = y: Fit(2) = 0
    
40.    
    
41.     'ThisDrawing.ModelSpace.AddPoint P0
    
42.     Do
    
43.         DoEvents
    
44.         
    
45.         i = i + 1
    
46.         n = n + 1
    
47.         ReDim Preserve Fit(n * 3 - 1)
    
48.         A1 = i * Pi / 180
    
49.         A2 = (R1 / R) * A1
    
50.    
    
51.         x = (-(R1 - R) * Cos(A1) - S * Cos(A2 - A1) + 100) * M
    
52.         y = ((R1 - R) * Sin(A1) - S * Sin(A2 - A1) + 100) * M
    
53.         P(0) = x: P(1) = y
    
54.         Fit(n * 3 - 3) = x: Fit(n * 3 - 2) = y: Fit(n * 3 - 1) = 0
    
55.         If n = 359 Then
    
56.             Set Sp = ThisDrawing.ModelSpace.AddSpline(Fit, Point3D(0, 0, 0), Point3D(0, 0, 0))
    
57.             Randomize
    
58.             'Sp.color = Int(Rnd * 255)
    
59.             n = 0
    
60.         End If
    
61.         If Abs(P(0) - P0(0)) < 10 ^ -2 And Abs(P(1) - P0(1)) < 10 ^ -2 Then Exit Do
    
62.         'If i > 10 ^ 4 Then Exit Do
    
63.      Loop
    
64.      MsgBox "R=" & R & "/ R1=" & R1 & "/ L=" & L
    
65.      Prompt "R=" & R & "/ R1=" & R1 & "/ L=" & L & "/ S=" & S & vbCrLf
    
66.      End
    
67. End Sub

Private Sub CommandButton2_Click()<br />     Dim i As Long<br />     Dim n As Integer<br />     Dim Pi As Double<br />     Pi = 4# * Atn(1#)<br />     Dim R As Long<br />     Randomize<br />     R = Int(Rnd * 100)<br />     Dim R1 As Long<br />     R1 = (0.5 - Rnd) * 199<br />     Dim L As Long<br />     L = Int(Rnd * 200)<br />     Dim S As Long<br />     S = Int(Rnd * 50)<br />     Dim M As Long<br />     M = Int(Rnd * 100)<br />     Dim A1 As Double<br />     Dim A2 As Double<br />     Dim P(2) As Double<br />     Dim P0(2) As Double<br />     Dim x As Double<br />     Dim y As Double<br />     <br />     Dim Fit() As Double<br />     Dim Sp As AcadSpline<br />     <br />     ReDim Fit(2)<br />     <br />     i = i + 1<br />     n = n + 1<br />     A1 = i * Pi / 180<br />     A2 = (R1 / R) * A1<br />     <br />     x = (-(R1 - R) * Cos(A1) - S * Cos(A2 - A1) + 100) * M<br />     y = ((R1 - R) * Sin(A1) - S * Sin(A2 - A1) + 100) * M<br />     <br />     P0(0) = x: P0(1) = y<br />     Fit(0) = x: Fit(1) = y: Fit(2) = 0<br />     <br />     'ThisDrawing.ModelSpace.AddPoint P0<br />     Do<br />         DoEvents<br />         <br />         i = i + 1<br />         n = n + 1<br />         ReDim Preserve Fit(n * 3 - 1)<br />         A1 = i * Pi / 180<br />         A2 = (R1 / R) * A1<br />     <br />         x = (-(R1 - R) * Cos(A1) - S * Cos(A2 - A1) + 100) * M<br />         y = ((R1 - R) * Sin(A1) - S * Sin(A2 - A1) + 100) * M<br />         P(0) = x: P(1) = y<br />         Fit(n * 3 - 3) = x: Fit(n * 3 - 2) = y: Fit(n * 3 - 1) = 0<br />         If n = 359 Then<br />             Set Sp = ThisDrawing.ModelSpace.AddSpline(Fit, Point3D(0, 0, 0), Point3D(0, 0, 0))<br />             Randomize<br />             'Sp.color = Int(Rnd * 255)<br />             n = 0<br />         End If<br />         If Abs(P(0) - P0(0)) < 10 ^ -2 And Abs(P(1) - P0(1)) < 10 ^ -2 Then Exit Do<br />         'If i > 10 ^ 4 Then Exit Do<br />      Loop<br />      MsgBox "R=" & R & "/ R1=" & R1 & "/ L=" & L<br />      Prompt "R=" & R & "/ R1=" & R1 & "/ L=" & L & "/ S=" & S & vbCrLf<br />      End<br /> End Sub

我08年写的一段VBA代码

jkop

很特别的玩意，很好的范例！收藏！

lee50310

v2.0將版主的程式功能再提升一些:

lee50310

此圖片產生圖形之參數設定值 可供參考