AutoCADマクロ屋本舗 掲示板

http://totthi.bbs.fc2.com/?act=reply&tid=16461714
http://totthi.bbs.fc2.com/?act=reply&tid=16425561

↑これらの質問では、LISPを使用する回答になっておりますが、
LT使いの人も、同じことをやりたい人は居るかもなので、
マクロとVBSを併用で作ってみました。

※このVBSにはAcadRemoconは必要ありません。
※VBS=AcadRemoconと思い込んでいる人も多いようですので念のため。
※「AcadRemoconって何？」って人は気にしなくて良いです。使いませんので。

まずは、下記のプログラム構文をコピーしてメモ帳に貼り付けて下さい。
そして、Dドライブの直下（フォルダを作らないでD:の中）に、「BNameCP.vbs」の名前で保存してください。
拡張子は「.txt」ではありません。「.vbs」です。
保存する際の文字コードは「ANSI」です。（これ大事）
保存したファイルのアイコンが水色の「S」という文字のロゴに変わっていれば正常に保存された事になります。
アイコンがテキストファイルのままなら、拡張子を確認して下さい。
本来は、保存ファイル名や保存する場所は、どこでも良いのですが、
今回は、従って下さい。うまく実行出来たら、お好きに変えて下さい。

↓ここからvbsプログラム

Option Explicit
Call Main
Sub Main

Dim s
WScript.Sleep 500
s = GetClipboardText()
s = mid(s , InStrRev(s , "LIST"))
If InStr(s , "ブロック名:") = 0 Then
s = "ブロックではありません"
Else
s = mid(s , InStr(s , "ブロック名:") + 6)
s = mid(s , InStr(s , Chr(34)) + 1)
s = mid(s , 1 , InStr(s , Chr(34)) - 1)
End If
PutInClipboardText s

End Sub

Function GetClipboardText()
Dim objHTML
Set objHTML = CreateObject("htmlfile")
GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
End Function


Public Sub PutInClipboardText(ByVal str)
Dim cmd

cmd = "cmd /c ""echo " & str & "| clip"""
CreateObject("WScript.Shell").Run cmd, 0
End Sub

↑ここまでvbsプログラム

次に、CADに下記のマクロを登録してください。

^C^CGRAPHSCR;LIST;si;\copyhist;GRAPHSCR;AI_STARTAPP "D:BNameCP.vbs"^M

※R版なのにlispではなく、こっちを試したい人は、
※R版には、AI_STARTAPPコマンドが有りませんので、この部分を変更して下さい。
※次のLUNEさんの書き込みを参照願います。

では、マクロを実行してください。
ブロックをクリックすると、ブロック名がクリップボードにコピーされます。

R版の登録マクロは、以下の通りです。

^C^CGRAPHSCR;LIST;si;\copyhist;GRAPHSCR;(STARTAPP "C:/WINDOWS/SYSTEM32/WSCRIPT.EXE" "D:BNameCP.vbs")(PRINC);