Dim Acad				'Acad変数はErサブルーチンでも使うのでここで宣言
Call Main				'Mainサブルーチンコール

Sub Main()				'エラー時にExit Subで中断出来るようにサブルーチン化する
	Set Acad = CreateObject("AcadRemocon.Body")
	Acad.acGetVar "dimscale", dims		'dimscaleの取得

	MH = 3.5 * dims											'文字高の設定
	gyo = 7 * dims											'行高さの設定
	gyo2 = 10 * dims										'見出し行高さの設定
	X1=15:X2=30:X3=50:X4=60:X5=85:X6=115:X7=140:X8=160		'列の設定

	If Not Acad.acGetPoint("鉄筋表の左上位置を指示", , X, Y) Then Er: Exit Sub
	Acad.acLine X,Y,X+X8*dims,Y
	Acad.acLine X,Y-gyo2,X+X8*dims,Y-gyo2
	Acad.acLine X,Y,X,Y-gyo2
	Acad.acLine X+X1*dims,Y,X+X1*dims,Y-gyo2
	Acad.acLine X+X2*dims,Y,X+X2*dims,Y-gyo2
	Acad.acLine X+X3*dims,Y,X+X3*dims,Y-gyo2
	Acad.acLine X+X4*dims,Y,X+X4*dims,Y-gyo2
	Acad.acLine X+X5*dims,Y,X+X5*dims,Y-gyo2
	Acad.acLine X+X6*dims,Y,X+X6*dims,Y-gyo2
	Acad.acLine X+X7*dims,Y,X+X7*dims,Y-gyo2
	Acad.acLine X+X8*dims,Y,X+X8*dims,Y-gyo2

	Acad.acPostCommand "-style Zenkaku^Mromans.shx,extfont.shx^M0 1 0 n n n "
															'全角文字の設定
	Acad.acText "MC",X+X1/2*dims,Y-gyo2/2,MH,0,"番号"
	Acad.acText "MC",X+(X1+X2)/2*dims,Y-gyo2/2,MH,0,"径"
	Acad.acText "MC",X+(X2+X3)/2*dims,Y-gyo2/4,MH,0,"長　さ"
	Acad.acText "MC",X+(X2+X3)/2*dims,Y-gyo2*0.75,MH,0,"（mm）"
	Acad.acText "MC",X+(X3+X4)/2*dims,Y-gyo2/2,MH,0,"本数"
	Acad.acText "MC",X+(X4+X5)/2*dims,Y-gyo2/4,MH,0,"単位質量"
	Acad.acText "MC",X+(X4+X5)/2*dims,Y-gyo2*0.75,MH,0,"（ｋｇｆ/ｍ）"
	Acad.acText "MC",X+(X5+X6)/2*dims,Y-gyo2/4,MH,0,"１本当たり質量"
	Acad.acText "MC",X+(X5+X6)/2*dims,Y-gyo2*0.75,MH,0,"（ｋｇｆ）"
	Acad.acText "MC",X+(X6+X7)/2*dims,Y-gyo2/4,MH,0,"質　量"
	Acad.acText "MC",X+(X6+X7)/2*dims,Y-gyo2*0.75,MH,0,"（ｋｇｆ）"
	Acad.acText "MC",X+(X7+X8)/2*dims,Y-gyo2/2,MH,0,"摘　要"

	Acad.acPostCommand "-style Hankaku^Mromans.shx,extfont.shx^M0 0.65 0 n n n "
															'半角文字の設定
	DD=2: BB=1
	Dim JJ(7),k(7)
	JJ(0)=0: JJ(1)=0: JJ(2)=0: JJ(3)=0: JJ(4)=0: JJ(5)=0: JJ(7)=0
	k(1)="6":k(2)="10":k(3)="13":k(4)="16":k(5)="19":k(6)="22":k(7)="25"
	Y=Y-3*dims
Do
	Y=Y-gyo
	If Not Acad.GetCombo(BB&"番の鉄筋径を選択　[ｷｬﾝｾﾙ]で合計","6|10|13|16|19|22|25",D,DD,DD) Then Exit Do
	If Not Acad.acDxfOut(BB&"番の鉄筋を選択", "", False) Then Er: Exit Sub
	If Not Acad.DxfExtract(N, XY, "ENTITIES", "", "LINE", "10|11|20|21") Then Er: Exit Sub
	If N = 0 Then Exit Sub

	LL=0
	For i = 1 To N
		L1=Round(((XY(1,i)-XY(2,i))^2+(XY(3,i)-XY(4,i))^2)^0.5,0)
		LL=LL+L1
	Next

	L=Round(LL/N,0)

	Select Case D
		Case 6
			TJ=0.249
		Case 10
			TJ=0.560
		Case 13
			TJ=0.995
		Case 16
			TJ=1.56
		Case 19
			TJ=2.25
		Case 22
			TJ=3.04
		Case 25
			TJ=3.98
	End Select

	J1=FormatNumber(L*TJ/1000,3)
'	J1=FormatNumber(Round(L*TJ/1000,3),3)
	J=FormatNumber(Round(J1*N,3),3)

	Acad.acLine X,Y-gyo,X+160*dims,Y-gyo
	Acad.acLine X,Y,X,Y-gyo
	Acad.acLine X+X1*dims,Y,X+X1*dims,Y-gyo
	Acad.acLine X+X2*dims,Y,X+X2*dims,Y-gyo
	Acad.acLine X+X3*dims,Y,X+X3*dims,Y-gyo
	Acad.acLine X+X4*dims,Y,X+X4*dims,Y-gyo
	Acad.acLine X+X5*dims,Y,X+X5*dims,Y-gyo
	Acad.acLine X+X6*dims,Y,X+X6*dims,Y-gyo
	Acad.acLine X+X7*dims,Y,X+X7*dims,Y-gyo
	Acad.acLine X+X8*dims,Y,X+X8*dims,Y-gyo
	Acad.acText "MC",X+X1/2*dims,Y-gyo/2,MH,0,BB
	Acad.acText "MC",X+(X1+X2)/2*dims,Y-gyo/2,MH,0,"D"&D
	Acad.acText "MR",X+(X3-6)*dims,Y-gyo/2,MH,0,L
	Acad.acText "MR",X+(X4-3)*dims,Y-gyo/2,MH,0,N
	Acad.acText "ML",X+(X4+8)*dims,Y-gyo/2,MH,0,TJ
	Acad.acText "MR",X+(X6-9)*dims,Y-gyo/2,MH,0,J1
	Acad.acText "MR",X+(X7-5)*dims,Y-gyo/2,MH,0,J
	BB=BB+1
	Select Case D
		Case 6
			JJ(1)=JJ(1)+J
		Case 10
			JJ(2)=JJ(2)+J
		Case 13
			JJ(3)=JJ(3)+J
		Case 16
			JJ(4)=JJ(4)+J
		Case 19
			JJ(5)=JJ(5)+J
		Case 22
			JJ(6)=JJ(6)+J
		Case 25
			JJ(7)=JJ(7)+J
	End Select
	JJ(0)=JJ(0)+J
Loop

	Acad.acLine X,Y-gyo,X+160*dims,Y-gyo
	Acad.acLine X,Y,X,Y-gyo
	Acad.acLine X+X1*dims,Y,X+X1*dims,Y-gyo
	Acad.acLine X+X2*dims,Y,X+X2*dims,Y-gyo
	Acad.acLine X+X3*dims,Y,X+X3*dims,Y-gyo
	Acad.acLine X+X4*dims,Y,X+X4*dims,Y-gyo
	Acad.acLine X+X5*dims,Y,X+X5*dims,Y-gyo
	Acad.acLine X+X6*dims,Y,X+X6*dims,Y-gyo
	Acad.acLine X+X7*dims,Y,X+X7*dims,Y-gyo
	Acad.acLine X+X8*dims,Y,X+X8*dims,Y-gyo
	For i = 7 To 0 Step -1
		If JJ(i)<>0 Then
			Y=Y-gyo
			Acad.acLine X,Y-gyo,X+160*dims,Y-gyo
			Acad.acLine X,Y,X,Y-gyo
			Acad.acLine X+X1*dims,Y,X+X1*dims,Y-gyo
			Acad.acLine X+X2*dims,Y,X+X2*dims,Y-gyo
			Acad.acLine X+X3*dims,Y,X+X3*dims,Y-gyo
			Acad.acLine X+X4*dims,Y,X+X4*dims,Y-gyo
			Acad.acLine X+X5*dims,Y,X+X5*dims,Y-gyo
			Acad.acLine X+X6*dims,Y,X+X6*dims,Y-gyo
			Acad.acLine X+X7*dims,Y,X+X7*dims,Y-gyo
			Acad.acLine X+X8*dims,Y,X+X8*dims,Y-gyo
			If i = 0 Then
				Acad.acPostCommand "textstyle Zenkaku^M"
				Acad.acText "MC",X+(X5+X6)/2*dims,Y-gyo/2,MH,0,"計"
				Acad.acPostCommand "textstyle Hankaku^M"
				Acad.acText "MR",X+(X7-5)*dims,Y-gyo/2,MH,0,FormatNumber(JJ(0),3)
			Else
				Acad.acText "MC",X+(X5+X6)/2*dims,Y-gyo/2,MH,0,"D"&k(i)
				Acad.acText "MR",X+(X7-5)*dims,Y-gyo/2,MH,0,FormatNumber(JJ(i),3)
			End If
		End If
	Next

End Sub

Sub Er()				'エラー処理
    If Acad.ErrNumber = vbObjectError + 1000 Then
		'ユーザーによるキャンセル時の処理
	Else
		Acad.ShowError				'エラー内容表示
	End If
End Sub