乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 51|回复: 2

如何发布我的VBA程序?!

[复制链接]

5

主题

6

帖子

1

银币

初来乍到

Rank: 1

铜币
26
发表于 2004-2-11 16:07:00 | 显示全部楼层 |阅读模式
这个我也做过,我自己写了一个宏。让cad启动时自动运行这个宏。有更好的方法,希望各位高手指点指点。
  1.   Sub InitializtionCAD()
  2.    On Error Resume Next
  3.    ThisDrawing.Utility.Prompt vbCrLf & "载入菜单同时在AutoCAD中显示"
  4.    ThisDrawing.Utility.Prompt vbCrLf & "加入CAD支持路径 "
  5.    ThisDrawing.Utility.Prompt vbCrLf & "--高武 2003年3月"
  6.    
  7.    
  8.        '增加支持路径
  9.        Dim preferences As AcadPreferences
  10.        Dim currSupportPath As String '支持目录
  11.        Dim supportFolder(0 To 10) As String
  12.       
  13.        supportFolder(0) = Application.Path & "\图库"
  14.        supportFolder(1) = Application.Path & "\属性"
  15.        supportFolder(2) = Application.Path & "\图框"
  16.        supportFolder(3) = Application.Path & "\图标BMP"
  17.        supportFolder(4) = Application.Path & "\尺寸标注式样"
  18.        supportFolder(5) = Application.Path & "\菜单文件"
  19.        supportFolder(6) = Application.Path & "\Support"
  20.        supportFolder(7) = Application.Path & "\Help"
  21.        supportFolder(8) = Application.Path & "\Express"
  22.        supportFolder(9) = Application.Path & "\Fonts"
  23.        supportFolder(10) = Application.Path & "\GaoWuCad2004"
  24.       
  25.        Set preferences = ThisDrawing.Application.preferences
  26.       
  27.        currSupportPath = preferences.Files.SupportPath
  28.        For i = 0 To 10
  29.            If InStr(1, currSupportPath, supportFolder(i), 1) = 0 Then
  30.                currSupportPath = currSupportPath & ";" & supportFolder(i)
  31.            End If
  32.        Next i
  33.        preferences.Files.SupportPath = currSupportPath
  34.        Set preferences = Nothing
  35.       
  36.        '改变打印样式搜索路径
  37.        ThisDrawing.Application.preferences.Files.PrinterStyleSheetPath = _
  38.        Application.Path & "\Plot Styles"
  39.        '改变打印机说明文字搜索路径
  40.        ThisDrawing.Application.preferences.Files.PrinterDescPath = _
  41.        Application.Path & "\Plotters\PMP Files"
  42.        '改变打印机配置搜索路径
  43.        ThisDrawing.Application.preferences.Files.PrinterConfigPath = _
  44.        Application.Path & "\Plotters"
  45.       
  46.    Err.Clear
  47.    Application.MenuGroups.Load ("定制菜单GaoWu.mns")
  48.    If Err Then
  49.    Else:
  50.        Application.MenuGroups("快捷命令").Menus.InsertMenuInMenuBar "快捷命令", 10
  51.    End If
  52.    Err.Clear
  53.    
  54. nd Sub
回复

使用道具 举报

26

主题

177

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
281
发表于 2004-2-11 16:25:00 | 显示全部楼层
好程序!!
回复

使用道具 举报

41

主题

657

帖子

9

银币

中流砥柱

Rank: 25

铜币
821
发表于 2004-2-11 17:56:00 | 显示全部楼层
我也要,谢谢
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 14:13 , Processed in 0.337249 second(s), 58 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表