双击CAD对象，显示自定义对话框实现方法（VB.NET)

dukeyongwang · 发表于 2009-11-6 15:23:00

果然在CAD2006中不太好实现的双击，在CAD2008中特容易实现，唉，看来要跟上时代的脚步，用2008开发了

cumtjh · 发表于 2011-7-1 01:20:52

雪山飞狐_lzh 发表于 2009-5-30 13:53
C#代码和VB.Net的代码相差不大的，网上有代码转换器可以试下，不过大体应该看的懂
完整的代码：

Class TlsApplication
Implements IExtensionApplication
Private Sub IExtensionApplication_Initialize() Implements IExtensionApplication.Initialize
TTest.Start()
End Sub
Private Sub IExtensionApplication_Terminate() Implements IExtensionApplication.Terminate
End Sub
End Class
Class TTest
Shared m_Veto As Boolean = False
Public Shared Sub Start()
Application.DocumentManager.DocumentLockModeChanged += New DocumentLockModeChangedEventHandler(AddressOf vetoCommand)
Application.BeginDoubleClick += New BeginDoubleClickEventHandler(AddressOf beginDoubleClick)
End Sub
Private Shared Sub beginDoubleClick(sender As Object, e As BeginDoubleClickEventArgs)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim res As PromptSelectionResult = ed.SelectImplied()
Dim ss As SelectionSet = res.Value
If ss IsNot Nothing Then
If ss.Count = 1 Then
Using tr As Transaction = doc.TransactionManager.StartTransaction()
Dim line As Line = TryCast(tr.GetObject(ss(0).ObjectId, OpenMode.ForRead), Line)
If line IsNot Nothing Then
Dim rb As ResultBuffer = line.GetXDataForApplication("MyApp")
If rb IsNot Nothing Then
m_Veto = True
End If
End If
End Using
End If
End If
End Sub
Private Shared Sub vetoCommand(sender As Object, e As DocumentLockModeChangedEventArgs)
If e.GlobalCommandName.ToLower() = "properties" Then
If m_Veto Then
e.Veto()
Application.ShowAlertDialog("hello")
m_Veto = False
End If
End If
End Sub
End Class

Class TlsApplication 
        Implements IExtensionApplication 
        Private Sub IExtensionApplication_Initialize() Implements IExtensionApplication.Initialize 
                TTest.Start() 
        End Sub 
        Private Sub IExtensionApplication_Terminate() Implements IExtensionApplication.Terminate 
        End Sub 
End Class 
Class TTest 
        Shared m_Veto As Boolean = False 
        Public Shared Sub Start() 
                Application.DocumentManager.DocumentLockModeChanged += New DocumentLockModeChangedEventHandler(AddressOf vetoCommand) 
                Application.BeginDoubleClick += New BeginDoubleClickEventHandler(AddressOf beginDoubleClick) 
        End Sub 
        Private Shared Sub beginDoubleClick(sender As Object, e As BeginDoubleClickEventArgs) 
                Dim doc As Document = Application.DocumentManager.MdiActiveDocument 
                Dim ed As Editor = doc.Editor 
                Dim res As PromptSelectionResult = ed.SelectImplied() 
                Dim ss As SelectionSet = res.Value 
                If ss IsNot Nothing Then 
                        If ss.Count = 1 Then 
                                Using tr As Transaction = doc.TransactionManager.StartTransaction() 
                                        Dim line As Line = TryCast(tr.GetObject(ss(0).ObjectId, OpenMode.ForRead), Line) 
                                        If line IsNot Nothing Then 
                                                Dim rb As ResultBuffer = line.GetXDataForApplication("MyApp") 
                                                If rb IsNot Nothing Then 
                                                        m_Veto = True 
                                                End If 
                                        End If 
                                End Using 
                        End If 
                End If 
        End Sub 
        Private Shared Sub vetoCommand(sender As Object, e As DocumentLockModeChangedEventArgs) 
                If e.GlobalCommandName.ToLower() = "properties" Then 
                        If m_Veto Then 
                                e.Veto() 
 
                                Application.ShowAlertDialog("hello") 
                                m_Veto = False 
                        End If 
                End If 
        End Sub 
End Class

sfzyr · 发表于 2023-10-29 03:17:50

本帖最后由 sfzyr 于 2023-12-4 02:27 编辑

雪山飞狐_lzh 发表于 2009-5-30 16:05
Com的版本，引用两个类型库

（这个 veto 在vlisp中，如何调用啊？）
Autodesk.AutoCAD.ApplicationServices这个在lisp中无法引入
另外e.veto,如何写。

;;;=======创建文档管理器反应器*docmReactor*及回调函数==============================
(defun at_docm_reactor (/)
(if (not *docmReactor*)
(setq *docmReactor*
(vlr-docmanager-reactor
nil
'((:vlr-documentLockModeChanged . vetoCommand))
)
)
) ;_定义文档管理器反应器*docmReactor*
)
(defun vetoCommand (reactorObject parameterlist / e)
(setq e parameterlist)
(if (wcmatch (strcase (nth 4 e)) "*eattedit*,*EATTEDIT*")
(progn
(princ "hello")
(princ "如何调用 veto()方法屏蔽（阻止）命令运行")
)
)
)
<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=188809&highlight=%CB%AB%BB%F7&_dsign=2338ef59" target="_blank">双击CAD对象，显示自定义对话框实现方法，用vlisp怎么调用这个veto()方法？ - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz! (mjtd.com)</a>

账号		自动登录	找回密码
密码			注册

[命令] 双击CAD对象，显示自定义对话框实现方法（VB.NET)