AutoCADマクロ屋本舗 掲示板

お世話になります。
以前、線分の両端に円をというマクロを作成いただき、便利に使わせています。
使っているうちに交点に円を書く方が便利ではないかと思いここにお願いさせていただきます。
ずぼらな性格ばかり、出てきて申し訳ありません、できたらでいいのでよろしくお願いします。

ん？
circleコマンドで交点指定するだけですよね？
マクロにするのは簡単ですが
shift＋右クリックでの
一時スナップではダメなんでしょうか？

早速のRes有り難うございます。
僕の表現がわかりにくいのか、技量がないのかいまいちわからないのですが。
無数の交点に一気に円を描くというか、コピーする方法です。

「線分に対しての交点全てに」であれば可能ですが
不規則な無数の交点に一気に円を描くのは難しいですね・・（汗

それで十分です。
私は、マウスのサイドボタンにdel とescを組み込んで作業しているので、書くよりも消すほうが楽なので、

よろしくお願いします。

katsuさん

「AcadRemocon」が導入済みならば、使えるVBSは提示できますが・・・・・

今回の件に関しては、
Denさんがおっしゃられるように
AcadRemoconの方でしょうね。。

マクロの領域超えています(^_^;)

AcadRemoconをご検討されてはいかがでしょうか。

色々とお気遣いありがとうございます。
AcadRemoconを導入済みですが、できる時とできないときがあったりして、いつかは原因を突き止めてｖｂｓの完全導入を目指そうと機会を伺っていたので、いい機会にめぐり合えたと思い勉強したいと思います。
Denさんよろしくお願いいたします。

とってぃさん色々とありがとうございます。

katsuさん

一応、134.交点指定ブロック挿入を元に
http://ameblo.jp/totthi-macro/entry-11492864266.html

作り直してみました。


♪交点指定円挿入
*^C^C$M=setenv;to;0;$(nth,$(getenv,to),;so;$(getvar,sortents);;sw;0;;r0;円の半径記入^x\;to;1,ray;int;【$(if,$(getenv,sw),2点間自動挿入,1点挿入)】^X\$M="""$(if,$(getvar,cmdactive),;setenv;to;2,setenv;sw;$(if,$(getenv,sw),0,1);;to;1)""",,,,,)$(nth,$(getenv,to),,,$(if,$(getenv,sw),sortents;127;line;non;@;int;\;ucs;ob;l;zoom;@;-10<0;setenv;to;4,setenv;to;3),circle;non;@;$(getenv,r0),,,)$(nth,$(getenv,to),,,,,;to;5;lengthen;non;0<0;;setenv;l1;$M="""$(getvar,perimeter);trim;c;non;0<0;non;$(getvar,perimeter)<0;;non;$(-,$(getvar,perimeter),0.1)"""<0;,;to;6;erase;l;;lengthen;non;0<0;;oops;copy;p;;non;@;non;@;erase;p;,)$(nth,$(getenv,to),,,,,,,circle;non;$(getenv,l1)<0;$(getenv,r0);setenv;to;$M="""$(if,$(=,$(getenv,l1),$(getvar,perimeter)),1;erase;non;0<0;;circle;non;0<0;$(getenv,r0);ucs;p;zoom;p;sortents;$(getenv,so),4)""")^M


使い方は
134.交点指定ブロック挿入
を参考にしてください。

▲注意
１．AutoCAD R/LT2010では動作不可
２．交点の感覚と、円の半径が交わると、正常動作しない場合があります。


結局、動作が不安定です・・（汗

Dim Acad
Call Main

Private Sub Main()
Set Acad = CreateObject("AcadRemocon.Body") 'AcadRemocon作成
If Not Acad.GetReal "円の半径を入力して下さい。",hankei,hankei,">0" '半径指定

Do
Acad.acPostCommand "_UNDO BE " 'UNDO記録開始
'図形選択→DXFファイル書き出し→線分抽出
If Not Acad.acDxfOut("【線分を一括選択／無選択で終了】", "", False,,"2000") Then Er: Exit Sub
If Not Acad.DxfExtract(Cnt, Arr, "ENTITIES", "", "LINE", "10|20|11|21|8") Then Er: Exit Sub
If Cnt < 2 Then Exit Sub

If Not Acad.acGetVar("LUPREC", Luprec) Then Er: Exit Sub '計算精度にLUPRECシステム変数を使う
Gosa = 10 ^ (Luprec * -1)

For i = 1 To Cnt - 1
For j = i + 1 To Cnt
If Acad.CalcCrossPoint(CpX, CpY, CDbl(Arr(1, i)), CDbl(Arr(2, i)), CDbl(Arr(3, i)), CDbl(Arr(4, i)), CDbl(Arr(1, j)), CDbl(Arr(2, j)), CDbl(Arr(3, j)), CDbl(Arr(4, j)), Gosa) = 1 Then
Acad.acPostCommand "_CIRCLE " & Acad.PT(CpX,CpY) & hankei & "^M" '円作図
End If
Next
Next
Acad.acPostCommand "_UNDO E " 'UNDO記録終了
Loop
End Sub


Sub Er() 'エラー処理
Acad.acPostCommand "_UNDO E 1 "
If Acad.ErrNumber = vbObjectError + 1000 Then
'ここにキャンセル時の処理を追加
Else
Acad.ShowError 'エラー内容表示
End If
End Sub

1)VBS起動
2)円の半径を入力
3)線分を選択
4)交点に円が記入されます
5)必要な範囲を繰り返し指定できます

なお、64ビットマシンの対応はAcadRemoconの掲示板を参考にして下さい。

色々と試させていただきました。
とってぃさんのマクロですが、なぜかうまくいきません。
以下がコマンドのコピーです。
コマンド:
コマンド: _.erase 認識された数: 1

コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: so
値 <127>: 127

コマンド:
コマンド:
SETENV 変数名を入力: sw
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: r0
値 <1>: 円の半径記入*削除*
円の半径記入

コマンド:
コマンド:
SETENV 変数名を入力: to
値 <0>: 1

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <1>: 0

コマンド:
コマンド: ray
始点を指定: int
どこの 【1点挿入】*削除*
【1点挿入】
通過点を指定:

コマンド: setenv
変数名を入力: to
値 <0>: 2

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <2>: 0

コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 3

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <3>: 0

コマンド:
コマンド: circle
円の中心点を指定 または [3 点(3P)/2 点(2P)/接、接、半(T)]: non
@

円の半径を指定 または [直径(D)] <1.0000>: 1

コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: so
値 <127>: 127

コマンド:
コマンド:
SETENV 変数名を入力: sw
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: r0
値 <1>: 円の半径記入*削除*
円の半径記入

コマンド:
コマンド:
SETENV 変数名を入力: to
値 <0>: 1

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <1>: 0

コマンド:
コマンド: ray
始点を指定: int
どこの 【1点挿入】*削除*
【1点挿入】
通過点を指定:

コマンド: setenv
変数名を入力: to
値 <0>: 2

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <2>: 0

コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 3

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <3>: 0

コマンド:
コマンド: circle
円の中心点を指定 または [3 点(3P)/2 点(2P)/接、接、半(T)]: non
@

円の半径を指定 または [直径(D)] <1.0000>: 1

コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: so
値 <127>: 127

コマンド:
コマンド:
SETENV 変数名を入力: sw
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: r0
値 <1>: 円の半径記入*削除*
円の半径記入*キャンセル*
; エラー: 関数は取り消されました

次に134をenというブロックを登録して試してみました。
以下です。
マンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: bl
値 <en>: en

コマンド:
コマンド:
SETENV 変数名を入力: so
値 <127>: 127

コマンド:
コマンド:
SETENV 変数名を入力: sw
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: to
値 <0>: 1

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <1>: 0

コマンド:
コマンド: ray
始点を指定: int
どこの 【1点挿入】*削除*
【1点挿入】
通過点を指定:

コマンド: setenv
変数名を入力: to
値 <0>: 2

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <2>: 0

コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 3

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <3>: 0

コマンド:
コマンド: -insert
ブロック名を入力 または [一覧(?)] <en>: en

単位: インチ 変換: 1.00000000
挿入位置を指定 または [基点(B)/尺度(S)/X/Y/Z/回転(R)]: s
XYZ 軸に対する尺度を指定 <1>: 1
挿入位置を指定 または [基点(B)/尺度(S)/X/Y/Z/回転(R)]: r

回転角度を指定 <0>: 0
挿入位置を指定 または [基点(B)/尺度(S)/X/Y/Z/回転(R)]: non
@

コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: bl
値 <en>: en

コマンド:
コマンド:
SETENV 変数名を入力: so
値 <127>: 127

コマンド:
コマンド:
SETENV 変数名を入力: sw
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: to
値 <0>: 1

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <1>: 0

コマンド:
コマンド: ray
始点を指定: int
どこの 【1点挿入】*削除*
【1点挿入】
通過点を指定:

コマンド: setenv
変数名を入力: to
値 <0>: 2

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <2>: 0

コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 3

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <3>: 0

コマンド:
コマンド: -insert
ブロック名を入力 または [一覧(?)] <en>: en

単位: インチ 変換: 1.00000000
挿入位置を指定 または [基点(B)/尺度(S)/X/Y/Z/回転(R)]: s
XYZ 軸に対する尺度を指定 <1>: 1
挿入位置を指定 または [基点(B)/尺度(S)/X/Y/Z/回転(R)]: r

回転角度を指定 <0>: 0
挿入位置を指定 または [基点(B)/尺度(S)/X/Y/Z/回転(R)]: non
@

コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: bl
値 <en>: en

コマンド:
コマンド:
SETENV 変数名を入力: so
値 <127>: 127

コマンド:
コマンド:
SETENV 変数名を入力: sw
値 <0>: 0

コマンド:
コマンド:
SETENV 変数名を入力: to
値 <0>: 1

コマンド:
コマンド:
コマンド:
コマンド: setenv
変数名を入力: to
値 <1>: 0

コマンド:
コマンド: ray
始点を指定: int
どこの 【1点挿入】*削除*
【1点挿入】*キャンセル*

両方とも同じ動きで最初の1点しかコピーされません
。
うまく動くと便利なんですけどね。
よろしくお願いします。

Denさんの方ですが
AcadRemoconの関連６４ビット関係で指摘されている症状になり途中で止まります。
これは色々と調べて動くようにしたいと思っています。

とってぃさん、 Denさん色々とありがとうございます。

コマンド:
コマンド: ray
始点を指定: int
どこの 【1点挿入】*削除*
【1点挿入】
通過点を指定:


ここで右ｸﾘｯｸすると、「2点間自動挿入」になります。

今一度
134.交点指定ブロック挿入
の "使い方" を参考にし、再度お試しください。

できました。
ありがとうございます。
134.をよく読めば書いてありますね。
思い込みが激しく、遮眼帯をつけているとよく言われますが、その象徴のようなことでしたね＾＾
そのことを補うために日々とってぃさん、他いろんな方々の協力をお願いしているわけです。
これで、作業がはかどります。
どうもありがとうございます。

Denさんへ
色々と調べて挑戦してみましたが、やはりだめでした。
AcadRemoconのホームページで皆さんができたというサンプルでも試してみましたが、だめです。
私の能力では無理みたいなのでｖｂｓはもう挑戦もする気力もなくなったのでこれで終わりにしたいと思います。ありがとうございました。
幸い　とってぃさんのマクロで作業がはかどるので由とします。
皆さんありがとうございます。