#Mark2 VBScript Command Version 1.00 '================================================ ' VBScript サンプルプログラム ' 台形を作図します ' ドラッキングを使用して配置&回転を行います '================================================ '* グローバル定義 const SI_NAVI_POINT = 1 '* 座標 const SI_PCS_ADDCHK = &H0002 ' チェックボタンの追加 const SI_PCS_CHECKED = &H0020 ' 項目にチェックが付いている const SI_PEX_LENGTH = 5 ' 長さ const SI_PEX_ANGLE = 7 ' 角度(度) const SI_OPE_INPUTCOORD = &H0001 ' 座標入力 const SI_OPE_OPERATIONBACK = &H0010 ' オペレーションバック const SI_OPE_OPERATIONFIXED = &H0020 ' オペレーション確定 const SI_OPE_OPERATIONRESTART= &H0040 ' オペレーション再スタート '* グローバル変数 Dim g_WorkFig '* 作業図面 Dim g_nWorkDtb '* 作業DTBの番号 Dim g_ptCenter '* 回転 - 中心 Dim g_ptRotate '* 回転角 Dim g_PID_Top '* プロパティアイテム番号(上辺) Dim g_PID_Bottom '* プロパティアイテム番号(下辺) Dim g_PID_Height '* プロパティアイテム番号(高さ) Dim g_PID_Rotate '* プロパティアイテム番号(回転) '================================================ ' コマンド起動時処理 '================================================ Sub Cmd_OnRun() Set siFig = Cmd.siFig Set siDtbCtrl = siFig.siDtbCtrl Set siProperty = Cmd.siProperty g_nWorkDtb = -1 '* ナビゲーション条件 Set Navi = Cmd.siNavi Set ElemMask=Navi.siElemMask ElemMask.SetBitAllOn ' Navi.SetTarget SI_NAVI_POINT, 0, 0 '* 作業用図面オブジェクトを作成 (ドラッキングデータはここに作成する) Set g_WorkFig = Cmd.CreateElement( "AutSiFig" ) If g_WorkFig is nothing Then MsgBox "作業用Figオブジェクトが作成できません" End If '* 作業用DTBを作成する。ここにドラッキング図形をセットする g_nWorkDtb = g_WorkFig.siDtbCtrl.CreateWork( &H00030003, &H0200, "") '* 非表示 If g_nWorkDtb<0 Then: MsgBox "作業用DTBが作成できません": Cmd.DoExit(): Exit Sub: End If '* コマンドプロパティを作成する g_PID_Top = siProperty.AddEdit( "上辺", "上辺の長さを入力します", SI_PCS_ADDCHK or SI_PCS_CHECKED, SI_PEX_LENGTH ) g_PID_Bottom = siProperty.AddEdit( "下辺", "下辺の長さを入力します", SI_PCS_ADDCHK or SI_PCS_CHECKED, SI_PEX_LENGTH ) g_PID_Height = siProperty.AddEdit( "高さ", "高さ入力します", SI_PCS_ADDCHK or SI_PCS_CHECKED, SI_PEX_LENGTH ) g_PID_Rotate = siProperty.AddEdit( "回転角", "回転角度を入力します", SI_PCS_ADDCHK, SI_PEX_ANGLE ) siProperty.SetValue g_PID_Top, 80.0 ' 上辺の初期値 siProperty.SetValue g_PID_Bottom, 100.0 ' 下辺の初期値 siProperty.SetValue g_PID_Height, 60.0 ' 高さの初期値 siProperty.Load False, "台形" ' 前回値を読み込む siProperty.Modify ' プロパティの状態をコントロールへ通知する '* オペレーションのイニシャライズ Cmd.SetOperationIndex 0 End Sub '================================================ ' コマンド終了時処理 '================================================ Sub Cmd_OnTerminate() ' コマンドプロパティを保存 Set siProperty = Cmd.siProperty siProperty.Save "台形" ' 後始末 if g_nWorkDtb>0 Then Cmd.siDrag.Reset TRUE g_WorkFig.siDtbCtrl.Destroy( g_nWorkDtb ) Set g_WorkFig = nothing g_nWorkDtb = -1 End If Set g_ptCenter = nothing Set g_ptRotate = nothing End Sub '================================================ ' オペレーションのイニシャライズ '================================================ Sub Cmd_OnInitOperation( nOpe ) Set siFig = Cmd.siFig Set siDtbCtrl = siFig.siDtbCtrl Set siLayerCtrl = siFig.siLayerCtrl Set siDrag = Cmd.siDrag Set siProperty = Cmd.siProperty siDrag.Reset TRUE g_WorkFig.siDtbCtrl.RemoveAll( g_nWorkDtb ) rTop = siProperty.GetValue( g_PID_Top ) ' 上辺 rBottom = siProperty.GetValue( g_PID_Bottom ) ' 下辺 rHeight = siProperty.GetValue( g_PID_Height ) ' 高さ dRotate = siProperty.GetValue( g_PID_Rotate ) ' 回転角度 '* 上辺が未入力か? If siProperty.IsEmpty( g_PID_Top ) Then Cmd.Operation 0 Cmd.SetStatusString "上辺を入力して下さい。" siProperty.Select g_PID_Top Exit Sub End If '* 下辺が未入力か? If siProperty.IsEmpty( g_PID_Bottom ) Then Cmd.Operation 0 Cmd.SetStatusString "下辺を入力して下さい。" siProperty.Select g_PID_Bottom Exit Sub End If '* 高さが未入力か? If siProperty.IsEmpty( g_PID_Height ) Then Cmd.Operation 0 Cmd.SetStatusString "高さを入力して下さい。" siProperty.Select g_PID_Height Exit Sub End If '* 回転角入力オペレーション時に回転角が拘束されたならば、登録オペレーションへ移行する If 1 = nOpe Then If False = siProperty.IsEmpty( g_PID_Rotate ) Then nOpe = 2 End if End if '* オペレーションのイニシャライズを行う Select Case nOpe Case 0 '****************** 配置点入力オペレーション If siProperty.IsEmpty( g_PID_Rotate ) Then dRotate = 0 End if Set BasePoint = Cmd.CreateElement( "AutSiDtPoint") BasePoint.x = 0: BasePoint.y = 0 Call CreateData( g_WorkFig, g_nWorkDtb, rTop, rBottom, rHeight, BasePoint, dRotate, True ) siDrag.Reset TRUE siDrag.SetPrll BasePoint, 0, 0.0, 0.0 '* 平行 siDrag.SetElem g_WorkFig, g_nWorkDtb '* 対象要素 Cmd.Operation SI_OPE_INPUTCOORD Cmd.SetStatusString "配置基準点を指定してください。" Case 1 '****************** 回転角入力オペレーション ' ドラッキング用に図面座標系へ変換 nActiveLayer = siLayerCtrl.GetActive() Set BasePoint = siLayerCtrl.Translate( nActiveLayer, -1, g_ptCenter ) Call CreateData( g_WorkFig, g_nWorkDtb, rTop, rBottom, rHeight, BasePoint, 0, True ) siDrag.Reset TRUE siDrag.SetRotate BasePoint, 0.0, 15. '* 回転 siDrag.SetElem g_WorkFig, g_nWorkDtb '* 対象要素 Cmd.Operation SI_OPE_INPUTCOORD or SI_OPE_OPERATIONRESTART or SI_OPE_OPERATIONBACK Cmd.SetStatusString "配置点を指定してください。" Case 2 '****************** 登録処理 ' レイヤ座標系を図面座標系に変換して角度を求める(見た目を合わす) If True = siProperty.IsEmpty( g_PID_Rotate ) Then Set Calc = Application.siCalc nActiveLayer = siLayerCtrl.GetActive() Set Point1 = siLayerCtrl.Translate( nActiveLayer, -1, g_ptCenter ) Set Point2 = siLayerCtrl.Translate( nActiveLayer, -1, g_ptRotate ) dRotate = Calc.Atan2d ( Point2.y-Point1.y, Point2.x-Point1.x ) End if iDbNo = siDtbCtrl.GetDtbNo("STANDARD DTB") siDtbCtrl.StartUndoBlock "VBS-台形" '* Undoの区切り開始 nNodeElemNo = siDtbCtrl.WriteNode( iDbNo, "VBS-台形", 0 ) '* 階層の親を登録 nLevel = siDtbCtrl.NodeBegin( iDbNo, nNodeElemNo ) Call CreateData( siFig, iDbNo, rTop, rBottom, rHeight, g_ptCenter, dRotate, False ) bRet = siDtbCtrl.NodeEnd( iDbNo, nLevel ) siDtbCtrl.EndUndoBlock '* Undoの区切り終了 siDrag.Erase siProperty.LockCheck -1 Cmd.SetOperationIndex 0 End Select End Sub '================================================ ' オペレーションの再スタート '================================================ Sub Cmd_OnCadEventOperationRestart( nID ) nOpeIndex = Cmd.GetOperationIndex If 0 < nOpeIndex Then Cmd.SetOperationIndex 0 End If End Sub '================================================ ' オペレーションのバック '================================================ Sub Cmd_OnCadEventOperationBack( nID ) nOpeIndex = Cmd.GetOperationIndex If 0 < nOpeIndex Then Cmd.SetOperationIndex nOpeIndex - 1 End If End Sub '================================================ ' 座標が入力された '================================================ Sub Cmd_OnCadEventInputCoord(iView, dspPoint) If 0 = Cmd.GetOperationIndex() Then Set g_ptCenter = dspPoint Cmd.SetOperationIndex 1 Else Set g_ptRotate = dspPoint Cmd.SetOperationIndex 2 End If End Sub '================================================ ' 図面が変更された '================================================ Sub Cmd_OnCadEventChangedFigure() Set siFig = Cmd.siFig Set siDrag = Cmd.siDrag siDrag.SetFig siFig '* 対象図面を切り替える Cmd.SetOperationIndex -1 End Sub '================================================ ' 属性が変更された '================================================ Sub Cmd_OnCadEventChangedAttributes ( nKind ) Cmd.SetOperationIndex -1 End Sub '================================================ ' コマンドプロパティの変更通知 '================================================ Sub Cmd_OnPropertyEventUpdateValue( nItem ) Cmd.SetOperationIndex -1 End Sub '================================================ ' 台形データを作成する '================================================ Sub CreateData( siFig, nDtbno, rTop, rBottom, rHeight, Offset, dRotate, bDrag ) Set siFigInt = siFig.siFigInt Set siDtbCtrl = siFig.siDtbCtrl Set Calc = Application.siCalc '* ドラッキング表示するデータを作成する Set LineAttr = Cmd.siFig.siFigInt.GetAttr( "AutSiLineAttr" ) LineAttr.Tips = 0: LineAttr.Tipe = 0 If True = bDrag Then LineAttr.Style = 0 LineAttr.ColorNo = 0 LineAttr.Pen = 0 End if Set Rec=Cmd.CreateElement( "AutSiDtbRecord" ) Set Arc=Cmd.CreateElement( "AutSiDtArc" ) Set Line=Cmd.CreateElement( "AutSiDtLine" ) Rec.Head.LayNo = siFig.siLayerCtrl.GetActive() 'アクティブレイヤ '* 右の線 Line.Start.x = (rBottom / 2) * 1 + Offset.x: Line.Start.y = (rHeight / 2) * -1 + Offset.y Line.End.x = (rTop / 2) * 1 + Offset.x: Line.End.y = (rHeight / 2) * 1 + Offset.y Calc.Rotate Line, Offset, dRotate Rec.SetData Line Rec.SetAttr LineAttr nElemNo = siDtbCtrl.WriteRecord( nDtbno, Rec ) '* 左の線 Line.Start.x = (rBottom / 2) * -1 + Offset.x: Line.Start.y = (rHeight / 2) * -1 + Offset.y Line.End.x = (rTop / 2) * -1 + Offset.x: Line.End.y = (rHeight / 2) * 1 + Offset.y Calc.Rotate Line, Offset, dRotate Rec.SetData Line Rec.SetAttr LineAttr nElemNo = siDtbCtrl.WriteRecord( nDtbno, Rec ) '* 上の線 Line.Start.x = (rTop / 2) * 1 + Offset.x: Line.Start.y = (rHeight / 2) * 1 + Offset.y Line.End.x = (rTop / 2) * -1 + Offset.x: Line.End.y = (rHeight / 2) * 1 + Offset.y Calc.Rotate Line, Offset, dRotate Rec.SetData Line Rec.SetAttr LineAttr nElemNo = siDtbCtrl.WriteRecord( nDtbno, Rec ) '* 下の線 Line.Start.x = (rBottom / 2) * 1 + Offset.x: Line.Start.y = (rHeight / 2) * -1 + Offset.y Line.End.x = (rBottom / 2) * -1 + Offset.x: Line.End.y = (rHeight / 2) * -1 + Offset.y Calc.Rotate Line, Offset, dRotate Rec.SetData Line Rec.SetAttr LineAttr nElemNo = siDtbCtrl.WriteRecord( nDtbno, Rec ) End Sub