AutoCADマクロ屋本舗 掲示板

お世話になります。
LT2021です。

ﾌﾞﾛｯｸを作成する場合、ブロック定義画面より行えば良いのですが
何時もオブジェクト選択⇒ｸﾘｯﾌﾟﾎﾞｰﾄﾞ⇒基点コピー⇒ブロックとして貼り付け
の流れで行っています。
このアプリ側で自動的に付けられたブロック名を以下の手順でマクロ作成可能でしょうか？
１．マクロ起動
２．オブジェクト左クリック
３．コマンドライン上で新しいブロック名記入
４．エンター又は右クリックで新規名称に書き換え完了

終了（ESC）するまで、継続する。

不明点が何点か

１.ブロック定義の仕様がわからない(チェックの有無や異尺度設定等)
２.オブジェクト左クリックとは？(オブジェクトを一つだけ選択する？)
３.挿入点は必要なしですか？
４.同じ名前が存在した場合はどうするか？

等ありますそれをふまえて

下記のLonさんのマクロ便利かもです

http://totthi.bbs.fc2.com/?act=reply&tid=16636891#24059508

お世話になります。

説明不足かと思います。
１.ブロック定義の仕様がわからない(チェックの有無や異尺度設定等)
　　->ﾌﾞﾛｯｸ自身は既に存在する状態になりますので
　　 問合せ頂いてる仕様に付いては不明（そのまま移行）です。

２.オブジェクト左クリックとは？(オブジェクトを一つだけ選択する？)
　　->はい、一つだけの選択です

３.挿入点は必要なしですか？
　　->1項同様です

４.同じ名前が存在した場合はどうするか？
　　->メッセージを出して新たな名前を入力

Lon様のﾏｸﾛ一度試したのですが、使い方が良く分からなったので。。。。
既に有るブロック名の変更と言う事でしょうか？
文字列は常にランダム設定なので少し違うのかな？と思いました。

すでにあるブロックの名称をマクロで取得することは
LTでは無理だと思われます

なので自分には回答出そうにありません
勘違い失礼しました

お世話になります。

有難うございます。

了解しました。

chibi-tomさんの書かれている通り、ブロックの名称をマクロで取得することは難しいので、
オブジェクト選択⇒ｸﾘｯﾌﾟﾎﾞｰﾄﾞ⇒基点コピー⇒ブロック
をせずに、
1.ブロック名指定
2.オブジェクト選択
3.基点指定
でブロック化できるマクロを作ってみました。R2020で動作確認しています。

*^C^C$M=setenv;ブロック名;\select;$(getenv,ブロック名)作成^X\id;挿入基点を指定^X\-block;$M="$(getenv,ブロック名);@;p;;-insert;$(getenv,ブロック名)";@;1;1;0;

補足説明
もし、すでにあるブロック名を指定した場合は、基点指定まで終わったあとに、
「置き換えますか? [はい(Y)/いいえ(N)] <N>:」
のメッセージが出ます。
残念ながら、Yを入力しても置き換えできるようにはなっていません。

http://totthi.bbs.fc2.com/?act=reply&tid=16622244#24000707
こちらの質問の時に、
「こっちにもマクロとか マクロじゃないのとか ありますよ。」として紹介したリンク先は見ましたか？
そして、マクロじゃない方法で、「AcadRemocon」という物を使う方法が出てきますが、やってみましたか？

もしやったのなら、今回の件もマクロ+VBS+AcadRemoconという合わせ技で可能です。

興味があるなら、AcadRemoconを準備して、VBSの使い方を調べてから次の書き込みを読んでください。
（準備方法や使い方は検索すれば色々な場所に書いてあると思う）
（例えばここのホームページのトップ画面にあるブックマークの中のKJU FACTORY）

マクロとvbs(with AcadRemocon)の合わせ技です。

①AcadRemoconのセッティングについては省略

②マクロボタンに下記マクロを登録
*^C^Clist;si;\copyhist;graphscr;AI_STARTAPP;"ブロック名取得.vbs";-rename;b^M
（R版の場合は、AI_STARTAPPでエラーになるので、R版用のマクロに改変してください）

③下記VBS（Dim Acad　～ End Function）を「ブロック名取得.vbs」という名前でAutoCADのサポートフォルダに保存。

これで準備ok

マクロを実行して、ブロックをクリック（ブロックじゃない物を選択したらどうなるか知りません）
そんでブロック名を入力すると書き換わる。
繰り返しモードになってるので、終了はEsc

但し、
既に使用しているブロック名を入力するとどうなるか知りません。
上書き保存をした後で実行してください。
何か深刻なエラーが出たら、ファイルを落として再度開いてください。
*○○のブロックは未対応です。選んだらエラーになると思います。



Dim Acad
'========== ***** ***** ==========
'極楽鳥さんに感謝！！
If MustRun Then WScript.Quit
'========== ***** ***** ==========

Call Main

Sub Main()
Set Acad = CreateObject("AcadRemocon.Body")

WScript.Sleep 100
Dim s
s=Acad.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

Acad.acPostCommand s & "^M"

End Sub

Public Function MustRun()
'実行している環境が64ビット環境か、32ビット環境か判断し、
'64ビット環境であれば、32ビット環境で自身の再起動を試みる。
'そして、Trueを返す。32ビット環境であれば、Falseを返す。
Const WSHOST = "wscript.exe"
Dim objWshShell 'WshShell オブジェクト
Dim ExecCmd '実行するコマンドライン

Set objWshShell = WScript.CreateObject("WScript.Shell")
If objWshShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") = "AMD64" Then
ExecCmd = objWshShell.ExpandEnvironmentStrings("%WINDIR%") & _
"\SysWOW64\" & WSHOST & " " & _
Chr(34) & WScript.ScriptFullName & Chr(34)
objWshShell.Exec(ExecCmd)
MustRun = True
Else 'x86
MustRun = False
End If

Set objWshShell = Nothing
Set ExecCmd = Nothing

End Function

これの元ネタは↓で、↑はブロック名変更の機能に作り変えています。
http://totthi.bbs.fc2.com/?act=reply&tid=16517487
そのリンク先の後半にも注意して欲しい事が書いてありますので、
参考にしてください。

お世話になります。

LUNE様
頂きましたマクロ、LT2021で動作確認が出来ました

Lon様
私には無理が有るようです。

有難う御座いました。