cad clipboard !!help!!

hanhanb

用鼠标在CAD中选择一个文字，然后提取其中的字符串并复制到clipboard中!

xie le !!!

兰州人

以前干过这活，搜下我发的帖子。

hanhanb

谢谢楼上！
问题已经解决了，当时是找不到MS forms 2.0 lib库，插入一个form就有了！

ningyong58

http://www.experts-exchange.com/Applications/CAD/Q_21731171.html

Sub VTC() 'short for SystemVariableToClipboard
   
    toClipboard
   
End Sub

Sub toClipboard() 'short for SystemVariableToClipboard
   
    Dim objectList As New DataObject
    Dim param As String
    Dim parameterArray() As String
    Dim ref As String

    parameterArray() = Split(ThisDrawing.Utility.GetString(False), " ")
    For i = 0 To UBound(parameterArray)
        ref = ref & getSysVar(parameterArray(i))
        If UBound(parameterArray) > 0 Then ref = ref & vbNewLine
    Next i
   
    objectList.SetText ref
    objectList.PutInClipboard
   
End Sub

Private Function getSysVar(varName As String) As String
Dim SysVar As String
Dim i As Integer

On Error Resume Next
SysVar = ThisDrawing.GetVariable(varName)
If Err <> 0 Then
    Err.Clear
    SysVar = varName
ElseIf varName = "DWGNAME" Then 'REMOVE DRAWING FILE EXTENSIOIN IE '.dwg'
    Do
    If Mid(SysVar, Len(SysVar) - i, 1) = "." Then
        SysVar = Left(SysVar, Len(SysVar) - i - 1)
        i = Len(SysVar)
    Else
        i = i + 1
    End If
    Loop While i < Len(SysVar)
End If

getSysVar = SysVar

End Function

Sub tt1()
Dim a As New DataObject
a.SetText "ABC"
a.PutInClipboard
End Sub
Sub tt2()
Dim a As New DataObject
a.GetFromClipboard
MsgBox a.GetText
End Sub

ningyong58

<br/>Sub llss1()<br/>  ThisDrawing.SendCommand "_ai_selall" &amp; vbCr<br/>  ThisDrawing.SendCommand "copyclip" &amp; vbCr<br/>End Sub

ningyong58

<br/>Sub llss1()<br/>  'ThisDrawing.SendCommand "_ai_selall" &amp; vbCr<br/>  Dim ent As AcadEntity<br/>  Set ent = ThisDrawing.HandleToObject("91")<br/>  ent.Highlight True<br/>  ThisDrawing.SendCommand "copyclip" &amp; vbCr &amp; "All" &amp; vbCr<br/>End Sub