请教一个很弱的问题！关于VBA的

huang82342 · 发表于 2009-10-20 14:22:45

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

问题1.为什么在百度搜出来的VBA 都是用OFFICE的Excel 里的宏打开》？？
我去试过了大不开
然后用AUTOCAD里的宏可以打开不过需要密码
问题2.怎么样可以CrackVBA的密码？有没有什么工具？（我现在要打开的VBA是我们公司一台数控冲床的CAD转换出NC程序的一个插件，不过里面设计有点不合理我想修改它）
请哪位高手帮帮忙

woaishuijia · 发表于 2009-10-20 15:54:16

一、很多大型工具软件都有VBA，比如WORD、EXCEL、AutoCAD。VBA的全称是Visual Basic for Applications，这是微软开发的面向应用程序的VB编程开发环境，通俗点说就是VB框架搭配上应用程序内核。所以EXCEL的VBA和AutoCAD的VBA是不一样的。
二、VBA密码Crack，下载附件并按说明操作。

VBA.rar (1.19 MB, 下载次数: 13)

mimimao383 · 发表于 2009-10-20 16:46:56

老师真是高手，几乎没有不懂的问题。

huang82342 · 发表于 2009-10-22 12:43:34

谢谢版主！~ 懂了
附件我下了希望可以解密码
中午就不试了
晚上回来在试试
谢谢版主！~厉害

huang82342 · 发表于 2009-10-22 12:55:03

本来想晚上回来在试试的
但是现在不试睡不着
嘿嘿

试了试
谢谢版主打开了那个文件
下面是代码
'Declare Function GS_MHDog Lib "win32dll.dll" (DogData As MH_DLL_PARA) As Long
'Declare Function InstDrv Lib "RCMicroDogSetup.dll" Alias "InstDriver" (ByVal a As Integer) As Integer
'Declare Function UninstDrv Lib "RCMicroDogSetup.dll" Alias "UninstallDriver" (ByVal a As Integer) As Integer
'Declare Function GetDogDriverInfo Lib "RCMicroDogSetup.dll" () As Long
'Declare Sub DriverDialog Lib "RCMicroDogSetup.dll" ()
'Declare Function NotifyPullOutAndPlugInUsbDog Lib "RCMicroDogSetup.dll" (ByVal a As Integer) As Integer

'Declare Function yy Lib "jmcar.dll" () As Long
'Public xxx As New CAMZDSHXJ
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFFFFFF
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Public Function getmac() As String
Dim retval
Dim pId As Long, pHnd As Long ' 分别声明 Process Id 及 Process Handle 变数
Dim MYSTR, lstr As String
If Dir("D:\cnc\hxj1.txt") = "" Then
  Else
Kill "d:\cnc\hxj1.txt "
  End If
  pId = Shell("cmd /C ipconfig /all > D:\CNC\hxj1.txt ", 0) ' Shell 传回 Process Id
  pHnd = OpenProcess(SYNCHRONIZE, 0, pId) ' 取得 Process Handle
  If pHnd <> 0 Then
Call WaitForSingleObject(pHnd, INFINITE) ' 无限等待，直到程序结束
Call CloseHandle(pHnd)
  End If
  Close
  Open "d:\cnc\hxj1.txt " For Input As #3
  Do While Not EOF(3)
Line Input #3, lstr
If InStr(lstr, "Physical Address") > 1 Then
   MYSTR = Split(lstr, ":", 2, 1)
   getmac = MYSTR(1)
   Exit Do
End If
Loop
  Close
End Function
Public Sub DelDoubleALL()  '删除重复图素
Dim i, j, k As Integer
Dim ssetObj As AcadSelectionSet
Dim dege1 As Double, dege2 As Double
Dim dege3 As Double, dege4 As Double
Dim pt1 As Variant, pt2 As Variant, Yuanr As Double, yuanr2 As Double
Dim pt10 As Variant, pt20 As Variant, Yuanr1 As Double
Dim ic As Integer
Dim str1 As String, str2 As String, id1 As String, id2 As String
Dim EntName() As String, line1() As Variant, line2() As Variant
Dim line3() As Double
Dim arc1() As Variant, arc2() As Double, arc3() As Double, arc4() As Double
Dim cir1() As Variant, cir2() As Double, blk1() As Variant
Dim blk2() As String
ic = ThisDrawing.SelectionSets.Count '选择集的个数
If ic > 0 Then
For i = ic - 1 To 0 Step -1
      Set ssetObj = ThisDrawing.SelectionSets(i)
      If ssetObj.Name = "SSSS" Then ssetObj.Delete '存在该选择集删除它
Next
End If
Set ssetObj = ThisDrawing.SelectionSets.Add("SSSS")
' Add objects to a selection set by prompting user to select on the screen
' ssetObj.SelectOnScreen
         ssetObj.Select acSelectionSetAll '把全部图形加入选择集
'          sele1.Select acSelectionSetAll, , , ft, fd  '层选择
On Error GoTo ccc1
ic = ssetObj.Count - 1
If ic < 1 Then '选择集孔或图素小于2则退出
   Exit Sub
End If
ReDim EntName(0 To ic)
ReDim line1(0 To ic): ReDim line2(0 To ic): ReDim line3(0 To ic)
ReDim arc1(0 To ic): ReDim arc2(0 To ic): ReDim arc3(0 To ic)
ReDim arc4(0 To ic)
ReDim cir1(0 To ic): ReDim cir2(0 To ic)
ReDim blk1(0 To ic): ReDim blk2(0 To ic)
With ssetObj
For i = 0 To ic
      EntName(i) = ssetObj.Item(i).ObjectName
      Select Case EntName(i)
      Case "AcDbLine"
         line1(i) = .Item(i).StartPoint
         line2(i) = .Item(i).EndPoint
         line3(i) = .Item(i).Angle
      Case "AcDbCircle"
            cir1(i) = .Item(i).Center
            cir2(i) = Int(.Item(i).Radius * 1000) / 1000
      Case "AcDbArc"
            arc1(i) = .Item(i).Center
            arc2(i) = Int(.Item(i).StartAngle * 1000) / 1000
            arc3(i) = Int(.Item(i).EndAngle * 1000) / 1000
            arc4(i) = Int(.Item(i).Radius * 1000) / 1000
      Case "AcDbBlockReference"
            blk1(i) = .Item(i).InsertionPoint
            blk2(i) = .Item(i).Name
      End Select

Next i

For i = 0 To ic - 1
id1 = EntName(i)
For j = i + 1 To ic
   id2 = EntName(j)
   If id1 = id2 Then
   Select Case id1
      Case "AcDbLine"
         pt1 = line1(i)
         pt2 = line2(i)
         dege1 = line3(i)
         pt10 = line1(j)
         pt20 = line2(j)
         dege2 = line3(j)
         If Abs(pt1(0) - pt10(0)) < 0.01 And Abs(pt1(1) - pt10(1)) < 0.01 And _
         Abs(pt2(0) - pt20(0)) < 0.01 And Abs(pt2(1) - pt20(1)) < 0.01 Then
            .Item(i).Delete
            Exit For
         End If
         If Int(Abs(dege1 - dege2) * 10000 + 0.5) / 10000 = 3.1416 Then
            If Abs(pt1(0) - pt20(0)) < 0.01 And Abs(pt1(1) - pt20(1)) < 0.01 And _
            Abs(pt2(0) - pt10(0)) < 0.01 And Abs(pt2(1) - pt10(1)) < 0.01 Then
               .Item(i).Delete
               Exit For
            End If
         End If
      Case "AcDbCircle"
         pt1 = cir1(i)
         Yuanr = cir2(i)
         pt2 = cir1(j)
         yuanr2 = cir2(j)
         If Sqr((pt1(0) - pt2(0)) ^ 2 + (pt1(1) - pt2(1)) ^ 2) < 0.01 And Yuanr = yuanr2 Then
            .Item(i).Delete
            Exit For
         Else
            If Sqr((pt1(0) - pt2(0)) ^ 2 + (pt1(1) - pt2(1)) ^ 2) < 8 Then
               .Item(i).color = acGreen
            End If
         End If
      Case "AcDbArc"
         pt1 = arc1(i)
         dege1 = arc2(i)
         dege2 = arc3(i)
         Yuanr = arc4(i)
         pt2 = arc1(j)
         dege3 = arc2(j)
         dege4 = arc3(j)
         yuanr2 = arc4(j)
         If Abs(pt1(0) - pt2(0)) < 0.01 And Abs(pt1(1) - pt2(1)) < 0.01 And Yuanr = yuanr2 _
         And dege1 = dege3 And dege2 = dege4 Then
            .Item(i).Delete
            Exit For
         End If
      Case "AcDbBlockReference"
         pt1 = blk1(i)
         str1 = blk2(i)
         pt2 = blk1(j)
         str2 = blk2(j)
         If Abs(pt1(0) - pt2(0)) < 0.01 And Abs(pt1(1) - pt2(1)) < 0.01 And _
         Trim(str1) = Trim(str2) Then
            .Item(i).Delete
            Exit For
         End If
      End Select
   End If
Next j
  Next i
  End With
'  MsgBox "删除重复完成！"
GoTo ccc2
ccc1:  MsgBox "有错！！！"
ccc2:    'ssetObj.Delete

End Sub

Public Function Clamp100(a1 As Double) As Double '判断块存在不存在，存在=100，不存在=0
Dim p1(0 To 2) As Double '交叉选择的左下角点
Dim p2(0 To 2) As Double '交叉选择的右上角点
Dim ssetObj As AcadSelectionSet
Dim ic As Integer, j As Integer
      ThisDrawing.SelectionSets("SSSS").Delete
      Set ssetObj = ThisDrawing.SelectionSets.Add("SSSS")
      p1(0) = a1 - 15: p1(1) = -25: p1(2) = 0
      p2(0) = a1 + 15: p2(1) = -5: p2(2) = 0
      ssetObj.Select acSelectionSetWindow, p1, p2
      For j = 0 To ssetObj.Count - 1
      ssetObj.Item(j).color = acGreen
      ssetObj.Item(j).Update
      Next j
      Clamp100 = ssetObj.Count
End Function

看不太懂不过我在这里多学学  应该没问题的  嘿嘿

通知

[已解决] 请教一个很弱的问题！关于VBA的

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分

浏览过的版块

		自动登录	找回密码
密码			注册