'表計算
'  by Den 2003/08/01〜2008/06/23

Dim Acad, Keisan, Keta, Syori
Call Main

Sub Main()
	Set Acad = CreateObject("AcadRemocon.Body")
	Acad.GetInival Keisan,"計算方法","Den表計算"	'前回の計算方法取得
	Acad.GetInival keta,"桁数","Den表計算"			'前回の桁数取得
	Acad.GetInival Syori,"端数処理","Den表計算"		'前回の端数処理取得
	Acad.GetIniStr B1, "計算式", "Den表計算"		'前回の計算式取得
	Acad.acGetVar "dimscale", dims					'dimscale取得
	Acad.acCheckTextHeight ,retTH					'文字スタイルの高さチェック（retTH=文字高さ）
	Acad.acPostCommand "^C^Cucs^Mw^M"				'UCSをワールド座標にする

	Do
		DialogCreate
		Do
			Acad.dlWaitEvent CtrlName, CtrlValue, CtrlListIndex
			Select Case CtrlName
				Case "cmdOK"
					Exit Do
				Case "cmdCancel"
					Er: Exit Sub
			End Select
		Loop While True

		Keisan = Acad.dlGetProperty("drp1", "Listindex")		'計算方法取得
		Keta = Acad.dlGetProperty("drp2", "Listindex")				'桁数取得
		Syori = Acad.dlGetProperty("drp3", "Listindex")				'桁数取得

		Select Case keta
			Case 0: FM = "0"
			Case 1: FM = "0.0"
			Case 2: FM = "0.00"
			Case 3: FM = "0.000"
			Case 4: FM = "0.0000"
			Case 5: FM = "0.00000"
			Case 6: FM = "0.000000"
		End Select

		Acad.PutIni Keisan, "計算方法", "Den表計算"		'計算方法の保存
		Acad.PutIni keta,"桁数","Den表計算"				'桁数の保存
		Acad.PutIni Syori, "端数処理", "Den表計算"		'端数処理の保存
		Acad.dlUnload							'ダイアログアンロード

		Select Case Keisan
			Case 1: Fugo = "-"
			Case 2: Fugo = "+"
			Case 3: Fugo = "*"
			Case 4: Figo = "/"
		End Select

		SS = 0		'総合計の初期化

		If Keisan = 0 Then
			If Not Acad.acDxfOut("【数値選択(文字含みOK、線分無視)】", "", False,,"2000") Then Er: Exit Sub
			If Not Acad.DxfExtract(N1, XY, "ENTITIES", "", "*TEXT", "1|40|67") Then Er: Exit Sub
			If N1 = 0 Then Acad.acShowMessage ("数値が未選択です"): Er: Exit Sub
			MH=XY(2,1)						'文字高取得
			For p = 1 To N1
				DL=""
				D=XY(1,p)
				For I = 1 To Len(D)			'数値のみを抽出
					D1 = mid(D,I,1)
					If asc(D1)<58 And asc(D1)>44 Then DL=DL+D1
				Next
				XY(1, p) = DL
				SS = SS + XY(1, p)
			Next

			Select Case Syori
				Case 1
					SS = Int(SS * 10^Keta)/10^Keta
				Case 2
					SS = Int(SS * 10^Keta + 0.9)/10^Keta
			End Select

			Acad.acGetPoint "【数値記入の基点右中をｸﾘｯｸ】", "", X1, Y1
			If retTH=0 Then
				Acad.acPostCommand "-text j MR non " & X1-dims & "," & Y1 & "^M" & MH & "^M0^M" & Acad.vbFormat(SS,FM) & "^M"
			Else
				Acad.acPostCommand "-text j MR non " & X1-dims & "," & Y1 & "^M0^M" & Acad.vbFormat(SS,FM) & "^M"
			End If
		Else
			If Keisan <= 4 Then
				If Not Acad.acDxfOut("【Ａ群選択(線分無視します)】", , False, ,"2000") Then Er: Exit Sub
			Else
				If Not Acad.acDxfOut("【数値選択(線分無視します)】", , False, ,"2000") Then Er: Exit Sub
			End If
			If Not Acad.DxfExtract(N1, XX, "ENTITIES", "", "*TEXT", "1|10|20|40|50|67") Then Er: Exit Sub
			If N1 = 0 Then Acad.acShowMessage ("数値が未選択です"): Er: Exit Sub
			MH=XX(4,1)						'文字高取得
			yoko=XX(5,1)					'文字方向0or90
			For p=1 to N1
				DL=""
				D=XX(1,p)
				For I = 1 To Len(D)			'数値のみを抽出
					D1=mid(D,I,1)
					If asc(D1)<58 And asc(D1)>44 Then DL=DL+D1
				Next
				XX(1,p)=DL
			Next

			If Keisan<>6 Then
				If yoko<>90 Then
					Do 
						gyaku=0
						For i=1 To N1-1
							If XX(3,i)<XX(3,i+1) Then
								tmp=XX(1,i+1):XX(1,i+1)=XX(1,i):XX(1,i)=tmp
								tmp=XX(2,i+1):XX(2,i+1)=XX(2,i):XX(2,i)=tmp
								tmp=XX(3,i+1):XX(3,i+1)=XX(3,i):XX(3,i)=tmp
								gyaku=1
							End If
						Next
					Loop While gyaku<>0
				Else
					Do 
						gyaku=0
						For i=1 To N1-1
							If XX(2,i)<XX(2,i+1) Then
								tmp=XX(1,i+1):XX(1,i+1)=XX(1,i):XX(1,i)=tmp
								tmp=XX(2,i+1):XX(2,i+1)=XX(2,i):XX(2,i)=tmp
								tmp=XX(3,i+1):XX(3,i+1)=XX(3,i):XX(3,i)=tmp
								gyaku=1
							End If
						Next
					Loop While gyaku<>0
				End If
			End If

			If Keisan <= 4 Then
				If Not Acad.acDxfOut("【Ｂ群選択(線分無視します)】", , False, ,"2000") Then Er: Exit Sub
				If Not Acad.DxfExtract(N, YY, "ENTITIES", "", "*TEXT", "1|10|20") Then Er: Exit Sub
				If N = 0 Then Acad.acShowMessage ("数値が未選択です"): Er: Exit Sub
				If N1<>N Then Acad.acShowMessage ("Ａ群とＢ群の個数が違います"): Er: Exit Sub
				For p=1 to N1
					DL=""
					D=YY(1,p)
					For I = 1 To Len(D)			'数値のみを抽出
						D1=mid(D,I,1)
						If asc(D1)<58 And asc(D1)>44 Then DL=DL+D1
					Next
					YY(1,p)=DL
				Next
				If yoko<>90 Then
					Do 
						gyaku=0
						For i=1 To N1-1
						If YY(3,i)<YY(3,i+1) Then
							tmp=YY(1,i+1):YY(1,i+1)=YY(1,i):YY(1,i)=tmp
							tmp=YY(2,i+1):YY(2,i+1)=YY(2,i):YY(2,i)=tmp
							tmp=YY(3,i+1):YY(3,i+1)=YY(3,i):YY(3,i)=tmp
							gyaku=1
						End If
						Next
					Loop While gyaku<>0
				Else
					Do 
						gyaku=0
						For i=1 To N1-1
						If YY(2,i)<YY(2,i+1) Then
							tmp=YY(1,i+1):YY(1,i+1)=YY(1,i):YY(1,i)=tmp
							tmp=YY(2,i+1):YY(2,i+1)=YY(2,i):YY(2,i)=tmp
							tmp=YY(3,i+1):YY(3,i+1)=YY(3,i):YY(3,i)=tmp
							gyaku=1
						End If
						Next
					Loop While gyaku<>0
				End If
			Else
				If Not Acad.GetString("数値を符号付で入力(例 /1000,*100+1.25)", B1, B1) Then Er: Exit Sub
				Acad.PutIni B1, "計算式", "Den表計算"							'計算式の保存
			End If

			If Keisan = 6 Then
				For i = 1 To N1
					XX(1,i)=Acad.vbFormat(Eval(XX(1,i)&B1),FM)
					If XX(6, i) = 1 Then XX(6, i) = 0						'ペーパー空間の処理
				Next
				If Not Acad.DxfUpdate(XX) Then Er: Exit Sub					'配列への変更をDXFファイルに反映
				If Not Acad.acDxfIn() Then Er: Exit Sub						'DXFIN実行
				If Not Acad.acPostCommand("erase^Mp^M^M") Then Er: Exit Sub	'直前の選択セットを削除
			Else
				If yoko <> 90 Then
					If Not Acad.acGetPoint("【計算結果記入の右揃え位置をクリック】", "", X, Y) Then Er: Exit Sub
					For i = 1 To N1
						Select Case Keisan
						Case 1,2,3,4
							Select Case Syori
								Case 1
									Ans = Int(Eval(XX(1,i)&Fugo&YY(1,i)) * 10^Keta)/10^Keta
								Case 2
									Ans = Int(Eval(XX(1,i)&Fugo&YY(1,i)) * 10^Keta + 0.9)/10^Keta
								Case Else
									If keisan = 4 Then
										Ans = Eval(XX(1,i) & "/" & YY(1,i))
									Else
										Ans = Eval(XX(1,i) & Fugo & YY(1,i))
									End If
							End Select
							If retTH=0 Then
								Acad.acPostCommand "-text j MR non " & X-dims & "," & XX(3, i)+MH/2 & "^M" & MH & "^M0^M" & Acad.vbFormat(Ans,FM) & "^M"
							Else
								Acad.acPostCommand "-text j MR non " & X-dims & "," & XX(3, i)+MH/2 & "^M0^M" & Acad.vbFormat(Ans,FM) & "^M"
							End If
						Case 5
							Select Case Syori
								Case 1
									Ans = Int(Eval(XX(1,i)&B1) * 10^Keta)/10^Keta
								Case 2
									Ans = Int(Eval(XX(1,i)&B1) * 10^Keta + 0.9)/10^Keta
								Case Else
									Ans = Eval(XX(1,i)&B1)
							End Select
							If retTH=0 Then
								Acad.acPostCommand "-text j MR non " & X-dims & "," & XX(3, i)+MH/2 & "^M" & MH & "^M0^M" & Acad.vbFormat(Ans,FM) & "^M"
							Else
								Acad.acPostCommand "-text j MR non " & X-dims & "," & XX(3, i)+MH/2 & "^M0^M" & Acad.vbFormat(Ans,FM) & "^M"
							End If
						End Select
					Next
				Else
					If Not Acad.acGetPoint("【計算結果記入の上揃え位置をクリック】", "", X, Y) Then Er: Exit Sub
					For i = 1 To N1
						Select Case Keisan
							Case 1,2,3,4
							Select Case Syori
								Case 1
									Ans = Int(Eval(XX(1,i)&Fugo&YY(1,i)) * 10^Keta)/10^Keta
								Case 2
									Ans = Int(Eval(XX(1,i)&Fugo&YY(1,i)) * 10^Keta + 0.9)/10^Keta
								Case Else
									If keisan = 4 Then
										Ans = Eval(XX(1,i) & "/" & YY(1,i))
									Else
										Ans = Eval(XX(1,i) & Fugo & YY(1,i))
									End If
							End Select
							If retTH=0 Then
								Acad.acPostCommand "-text j MR non " & XX(2,i)-MH/2 & "," & Y-dims & "^M" & MH & "^M90^M" & Acad.vbFormat(Ans,FM) & "^M"
							Else
								Acad.acPostCommand "-text j MR non " & XX(2,i)-MH/2 & "," & Y-dims & "^M90^M" & Acad.vbFormat(Ans,FM) & "^M"
							End If
							Case 5
							Select Case Syori
								Case 1
									Ans = Int(Eval(XX(1,i)&B1) * 10^Keta)/10^Keta
								Case 2
									Ans = Int(Eval(XX(1,i)&B1) * 10^Keta + 0.9)/10^Keta
								Case Else
									Ans = Eval(XX(1,i)&B1)
							End Select
							If retTH=0 Then
								Acad.acPostCommand "-text j MR non " & XX(2,i)-MH/2 & "," & Y-dims & "^M" & MH & "^M90^M" & Acad.vbFormat(Ans,FM) & "^M"
							Else
								Acad.acPostCommand "-text j MR non " & XX(2,i)-MH/2 & "," & Y-dims & "^M90^M" & Acad.vbFormat(Ans,FM) & "^M"
							End If
						End Select
					Next
				End If
			End if
		End If
	Loop

End Sub


Sub DialogCreate()											'ダイアログ作成&表示
	Acad.dlLoad "表計算(文字含みも可能)",, 1							'ダイアログ開始

	Acad.dlAddDrop "drp1", "総合計|引き算(A群−B群)|足し算(A群＋B群)|掛け算(A群×B群)|割り算(A群÷B群)|固定計算(別位置整列)|固定計算(元位置書換)", Keisan, 24, 2

	Acad.dlAddLabel "", "桁", 2, -1, 1
	Acad.dlAddDrop "drp2", "0|1|2|3|4|5|6", Keta, 6, -1
	Acad.dlAddLabel ""," 処理", 5, -1, 1
	Acad.dlAddDrop "drp3", "四捨五入|切捨て|切上げ", Syori, 11, 2
	Acad.dladdButton "cmdOK", "文字選択(Enter)", 17, -1
	Acad.dlSetProperty "cmdOK", "Default", True					'Enterで文字選択開始
	Acad.dlAddLabel "","",1,-1,1
	Acad.dlAddButton "cmdCancel", "終了", 6, 0
	Acad.dlShow													'ダイアログ表示
End Sub


Sub Er()			'エラー処理
	Acad.acPostCommand "^C^Cucs^Mp^M"							'UCSを元に戻す
	If Acad.ErrNumber = vbObjectError + 1000 Then
		
	Else
		Acad.ShowError			'エラー内容表示
	End If
End Sub