社区 › 源码共享 › 万花尺

飞雪神光 发表于 2024-12-26 21:36:21

万花尺

模仿孩子的玩具 写的一个万花尺的效果 看效果是对了 又感觉算法有点啥问题 供大家围观

lee50310 发表于 2025-1-2 13:33:12

本帖最后由 lee50310 于 2025-1-2 14:15 编辑

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

煮茗 发表于 2024-12-27 15:31:56

cghdy 发表于 2024-12-27 15:19
这啥软件啊
dynamo。Revit的二次开发用的软件。

tiancao100 发表于 2024-12-28 20:28:28

本帖最后由 tiancao100 于 2024-12-28 20:29 编辑

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

林立 发表于 2024-12-26 22:15:26

会卡住，未响应

寒潮大冬瓜 发表于 2024-12-27 00:21:41

很好→很棒！很好~很棒！！很好……很棒！！！
院长前一段时间有在分享类似的……
命令: C:\Users\46246\AppData\Local\Temp\Drawing6_zws27328.zs$
命令: (progn (load "C:/XCAD/tt2024-12-26万花尺飞雪神光发表于2024-12-26明经.lsp")(princ))
Error: undefined function - 出处:

煮茗 发表于 2024-12-27 11:03:20

以前也玩过

yangyangyixia 发表于 2024-12-27 12:21:39

会卡住，然后就没反应了

飞雪神光 发表于 2024-12-27 12:30:49

卡住的 试试缩小屏幕

帝都划水王 发表于 2024-12-27 13:57:20

煮茗 发表于 2024-12-27 11:03
以前也玩过

很神奇的软件

cghdy 发表于 2024-12-27 15:19:55

煮茗 发表于 2024-12-27 11:03
以前也玩过

这啥软件啊

mahuan1279 发表于 2024-12-27 21:01:13

这是干啥用的？

查看完整版本: 万花尺