AutoCADマクロ屋本舗 掲示板

https://totthi.bbs.fc2.com/?act=reply&tid=16719821#24379518
この話の続きですけど、タイトルと内容が違ってくるので別スレッドにします。

次のお題はこれで考えてみました。
https://totthi.bbs.fc2.com/?act=reply&tid=16719986#24379224

クリップ操作を別ルーチンにしたので、
Option Explicit
Call Main
Sub Main

End sub
の形にしました。


'VBSプログラムはここから↓+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Option Explicit
Call Main
Sub Main

'クリップボードから文字列取得
Dim ClipTxt, aryStr
WScript.Sleep 500
ClipTxt = GetClipboardText()

'取得した文字列に"-----------"が含まれない場合は終了
If InStr(ClipTxt, "-----------") = 0 Then Wscript.Quit
'取得した文字列の"-----------"以降を取り出し
ClipTxt = Mid(ClipTxt, InStrRev(ClipTxt, "-----------"))
'取得した文字列を一行づつ配列に変換
aryStr = Split(ClipTxt, vbCrLf)

Dim I
Dim TmpStr , LayN , ScrMsg
Dim FrzFlg

FrzFlg = False
ScrMsg = "-layer" & vbCrLf

'一行づつ、画層名を取り出し、非表示か、非印刷のフラグを確認し、該当すればフリーズ命令追加
For I = 0 to UBound(aryStr)
If InStr(aryStr(I), chr(34)) > 0 Then
TmpStr = Mid(aryStr(I), InStr(aryStr(I), chr(34)) + 1)
LayN = Mid(TmpStr, 1, InStr(TmpStr, chr(34)) - 1)
If (InStr(TmpStr, "非表示") > 0 or InStr(TmpStr, "-P") = 0) and InStr(TmpStr, "表示") > 0 Then
If Not Lcase(LayN) = "defpoints" Then
FrzFlg = True
ScrMsg = ScrMsg & "f" & vbCrLf & LayN & vbCrLf
End If
End If
End If
Next


'スクリプト作成
Dim cmd
ScrMsg = ScrMsg & vbCrLf
'クリップボードへスクリプト格納
SetClipboard ScrMsg

If FrzFlg Then
MsgBox ScrMsg & "クリップボードに上記のスクリプトをコピーしました" & vbCrLf & "コマンドラインに貼り付けてください"
Else
MsgBox "この図面に非表示及び非印刷の画層は有りません。"
End If

End Sub


'クリップボードから文字列取得
Function GetClipboardText()
Dim objHTML
Set objHTML = CreateObject("htmlfile")
GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
End Function


'クリップボードに文字列格納
Function SetClipboard(ScrMsg)
Dim ws, cl, si
Set ws = CreateObject("WScript.Shell")
Set cl = ws.Exec("Clip")
Set si = cl.stdIn
'si.WriteLine ScrMsg
si.Write ScrMsg
si.Close
Set si = Nothing
Set cl = Nothing
SEt ws = Nothing
End Function


'↑VBSプログラムはここまで+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


'マクロはこれを使用します。
^C^C$M=qaflags;6;-layer;?;*;;copyhist;qaflags;$(getvar,qaflags);^C

使用方法：
①マクロを実行
②VBSファイルダブルクリック
③コマンドラインを一回左クリックして、その後右クリックして、貼り付け。

です。


①と②を連動させるなら、こちらのマクロで。（フルパス/hogehogeの部分は自分で保存したパスと、ファイル名に合わせて書き換える）
レギュラー版の人は、このマクロ
^C^C$M=qaflags;6;-layer;?;*;;copyhist;qaflags;$(getvar,qaflags);GRAPHSCR;(STARTAPP "C:/WINDOWS/SYSTEM32/WSCRIPT.EXE" "フルパス/hogehoge.vbs")(PRINC);
LT版の人は、このマクロ
^C^C$M=qaflags;6;-layer;?;*;;copyhist;qaflags;$(getvar,qaflags);GRAPHSCR;AI_STARTAPP "フルパス/hogehoge.vbs"^M