乐筑天下

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

取消定义/重定义外部参照

[复制链接]

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-22 06:00:58 | 显示全部楼层 |阅读模式
您好,我想创建一个VBA模块来取消定义外部参照命令,然后创建一个名为'外部参照',然后重新定义它。这可能吗?请帮忙。谢谢
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-22 09:05:07 | 显示全部楼层
回复

使用道具 举报

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2007-3-27 01:25:58 | 显示全部楼层
重新定义…实际上没有必要…当用户在命令行中键入xref时,ActiveUCS应立即转到'世界',以及ActiveLayer应转至#039;0'. 然后会弹出“外部参照”对话框。通过“外部参照”对话框插入图形后,图层和ucs应恢复到原来的状态。这能做到吗
谢谢
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-27 08:15:43 | 显示全部楼层
是的,您可以使用活动文档的BeginCommand事件来执行此操作
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-27 10:12:00 | 显示全部楼层
唐#039;不要忘了XATTACH。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-28 00:32:13 | 显示全部楼层
这是我写的代码。但不幸的是,它'它不工作
请帮忙
  1. Option Explicit
  2. Dim CurUCS As AcadUCS
  3. Dim CurLayer As AcadLayer
  4. Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
  5. If CommandName = "XREF" Or CommandName = "XATTACH" Then
  6. Set CurUCS = ThisDrawing.ActiveUCS
  7. Set CurLayer = ThisDrawing.ActiveLayer
  8. SendKeys "{Esc}"
  9. ThisDrawing.SendCommand "ucs" & vbCr & "world" & vbCr
  10. ThisDrawing.Layers("0").Freeze = False
  11. ThisDrawing.Layers("0").LayerOn = True
  12. ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
  13. End If
  14. End Sub
  15. Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
  16. If CommandName = "XREF" Or CommandName = "XATTACH" Then
  17. ThisDrawing.ActiveUCS = CurUCS
  18. ThisDrawing.ActiveLayer = CurLayer
  19. End If
  20. End Sub
谢谢
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-28 08:15:58 | 显示全部楼层
我不知道't认为你'我们将能够在启动另一个命令时有效地使用sendkeys功能。您可能希望以编程方式设置UCS,而不是使用sendkeys函数
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-28 10:24:27 | 显示全部楼层
这似乎有效
  1. Sub owcs()
  2.     Dim zero(2) As Double
  3.     Dim Xaxis(2) As Double
  4.     Dim Yaxis(2) As Double
  5.     Dim strNm As String, sUcs As String
  6.     Dim oUcs As AcadUCS
  7.    
  8.     If ThisDrawing.GetVariable("WORLDUCS") = 1 Then
  9.         Exit Sub
  10.     Else
  11.         sUcs = ThisDrawing.GetVariable("UCSNAME")
  12.         'Debug.Print sUcs
  13.         Xaxis(0) = 1: Yaxis(1) = 1
  14.         Set oUcs = ThisDrawing.UserCoordinateSystems.Add(zero, Xaxis, Yaxis, "World")
  15.         ThisDrawing.ActiveUCS = oUcs
  16.     End If
  17. End Sub
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-28 23:57:56 | 显示全部楼层
我复制了WCS,一切都很好。但有一个问题。如果用户单击“外部参照”对话框's Cancel按钮,旧UCS和层不会恢复,因为它没有#039;t执行EndCommand事件。我已经给出了在EndCommand事件中恢复旧UCS和层的代码。有解决方法吗
谢谢
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-29 00:26:52 | 显示全部楼层

过去对我有效的方法是在begincommand事件中设置一个配置变量,然后在end command事件中清除它…当然,过滤正确的命令名…现在在begin command事件,如果变量已经设置,那么清除它并重置上次触发begincommand事件时保存的先前设置
流程如下所示:
[开始命令]
<检查配置设置&gt
如果设置为true,则重置绘图变量;验证外部参照调用(&gt)
<设置配置设置&gt
<保存当前设置&gt
<更改图纸变量(&T)
运行xref命令;验证外部参照调用(&gt)
<重置绘图变量(&gt)
<清除配置设置&gt
此场景将重置以前没有'当外部参照被取消时,在运行另一个命令时,不能立即重置。但是,请注意,为了捕捉大多数场景,您还需要使用Begin Lisp事件验证设置。
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-7 14:27 , Processed in 0.492294 second(s), 73 queries .

© 2020-2025 乐筑天下

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