花生 发表于 2004-2-11 16:07:00

subtlation 发表于 2004-2-11 16:25:00

这个我也做过，我自己写了一个宏。让cad启动时自动运行这个宏。有更好的方法，希望各位高手指点指点。Sub InitializtionCAD()
   On Error Resume Next
   ThisDrawing.Utility.Prompt vbCrLf & "载入菜单同时在AutoCAD中显示"
   ThisDrawing.Utility.Prompt vbCrLf & "加入CAD支持路径 "
   ThisDrawing.Utility.Prompt vbCrLf & "－－高武 2003年3月"
   
   
       '增加支持路径
       Dim preferences As AcadPreferences
       Dim currSupportPath As String '支持目录
       Dim supportFolder(0 To 10) As String
      
       supportFolder(0) = Application.Path & "\图库"
       supportFolder(1) = Application.Path & "\属性"
       supportFolder(2) = Application.Path & "\图框"
       supportFolder(3) = Application.Path & "\图标BMP"
       supportFolder(4) = Application.Path & "\尺寸标注式样"
       supportFolder(5) = Application.Path & "\菜单文件"
       supportFolder(6) = Application.Path & "\Support"
       supportFolder(7) = Application.Path & "\Help"
       supportFolder(8) = Application.Path & "\Express"
       supportFolder(9) = Application.Path & "\Fonts"
       supportFolder(10) = Application.Path & "\GaoWuCad2004"
      
       Set preferences = ThisDrawing.Application.preferences
      
       currSupportPath = preferences.Files.SupportPath
       For i = 0 To 10
         If InStr(1, currSupportPath, supportFolder(i), 1) = 0 Then
               currSupportPath = currSupportPath & ";" & supportFolder(i)
         End If
       Next i
       preferences.Files.SupportPath = currSupportPath
       Set preferences = Nothing
      
       '改变打印样式搜索路径
       ThisDrawing.Application.preferences.Files.PrinterStyleSheetPath = _
       Application.Path & "\Plot Styles"
       '改变打印机说明文字搜索路径
       ThisDrawing.Application.preferences.Files.PrinterDescPath = _
       Application.Path & "\Plotters\PMP Files"
       '改变打印机配置搜索路径
       ThisDrawing.Application.preferences.Files.PrinterConfigPath = _
       Application.Path & "\Plotters"
      
   Err.Clear
   Application.MenuGroups.Load ("定制菜单GaoWu.mns")
   If Err Then
   Else:
       Application.MenuGroups("快捷命令").Menus.InsertMenuInMenuBar "快捷命令", 10
   End If
   Err.Clear
   
nd Sub

myfreemind 发表于 2004-2-11 17:56:00

好程序！！

mikewolf2k 发表于 2004-2-11 18:54:00

我也要,谢谢
页: [1]
查看完整版本: 如何发布我的VBA程序？！