| tiancao1001 于 2008-07-17 09:03 PM 发表评论: | 
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  |  
  | 
| 查看所评论的日志:CAD VBA 也能画出这样的样条曲线spirograph万花尺螺旋曲线 | 
| tiancao1001 于 2008-07-16 02:58 PM 发表评论: | 
 Sub DeleteMenu()     '读取有那些菜单     Dim i As Integer     Dim i1 As Integer     Dim i2 As Integer     Dim index() As Long     Dim DataString As String     Set FSO = CreateObject("Scripting.FileSystemObject")     Set FSO_File = FSO.OpenTextFile(GetPath & "menu.txt", ForReading, True)     Do While Not FSO_File.AtEndOfStream             DataString = FSO_File.ReadLine             i = inStr_n(DataString, ",", index)             If i = 0 Then                 i1 = Val(DataString)             ElseIf i = 1 Then                 DataString = Left(DataString, Len(DataString) - 1)                 For Each TG In ThisDrawing.Application.MenuGroups                     For Each T In TG.Toolbars                         If T.Name = DataString Then                             T.Delete                             i2 = i2 + 1                             If i2 = i1 Then Exit Do                         End If                     Next                 Next             End If     Loop     FSO_File.Close End Sub  |  
  | 
| 查看所评论的日志:ACAD vba  CreateMenu2.0 自动生成CAD工具栏 | 
| tiancao1001 于 2008-07-15 05:31 PM 发表评论: | 
 '样条曲线转化为直线(针对上面函数转化后的样条曲线) Sub SPlineToLine()     Dim E  As AcadEntity     Dim L  As AcadLine     Dim SP As AcadSpline     Dim StartP As Variant     Dim EndP As Variant          For Each E In ThisDrawing.ModelSpace         'DoEvents         'ThisDrawing.Utility.Prompt E.ObjectName         If E.ObjectName = "AcDbSpline" Then             Set SP = E                          StartP = SP.GetFitPoint(0)             EndP = SP.GetFitPoint(2)                          Set L = ThisDrawing.ModelSpace.AddLine(StartP, EndP)             L.Layer = SP.Layer             L.color = SP.color             SP.Delete         End If     Next E End Sub  |  
  | 
| 查看所评论的日志:VBA将所有的直线转换成样条曲线 | 
| tiancao1001 于 2008-07-11 11:38 PM 发表评论: | 
Sub Delete_HyperLinks()     On Error Resume Next     Dim Hyperlinks As AcadHyperlinks     Dim Hyperlink As AcadHyperlink          Dim Obj As AcadEntity     Dim i As Integer     Dim j As Long     For Each Obj In ThisDrawing.ModelSpace         DoEvents         Set Hyperlinks = Obj.Hyperlinks         MsgBox Hyperlinks.Count         i = Hyperlinks.Count         For j = 0 To i - 1             Hyperlinks.item(j).Delete         Next j     Next
  End Sub |  
  | 
| 查看所评论的日志:CAD 对象加上超链接 | 
| tiancao1001 于 2008-07-04 09:27 PM 发表评论: | 
 | 
| 查看所评论的日志:田草日志 | 
| tiancao1001 于 2008-06-26 09:34 PM 发表评论: | 
| 直接修改主页的地址可以被很多软件检测到,可以直接修改windows快捷方式的参数, |  
  | 
| 查看所评论的日志:田草日志 | 
| tiancao1001 于 2008-06-26 08:59 PM 发表评论: | 
| 中望cad 2007 和2008i的破解方法是一样的,都是搜素16进制FFD7595950,找到后将50改为51保存退出.然后运行中望CAD,点击注册,随便填入数字,点击注册即可成功!!, |  
  | 
| 查看所评论的日志:田草日志 | 
| tiancao1001 于 2008-06-22 08:35 PM 发表评论: | 
| 修行功德圆满,要到到猴年马月,现在不靠坑蒙拐骗,生活的很难保证 |  
  | 
| 查看所评论的日志:田草日志 |