田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID

评论列表

tiancao1001
所发表的评论
[28] [29] [30] [31] [32] [33] [34] [35] [36] [37]  ... [37]  
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 发表评论:
修行功德圆满,要到到猴年马月,现在不靠坑蒙拐骗,生活的很难保证
查看所评论的日志:田草日志
[28] [29] [30] [31] [32] [33] [34] [35] [36] [37]  ... [37]  
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©