프로그래밍을 일상 생활속으로

아래 매크로를 사용하여 텍스트의 폰트를 일괄 수정할 수 있습니다. Font No는 특정 텍스트 파일(C:\Temp\ChgFnt.dat)에 입력하였습니다. '-------------------------------------------------------------'' main - Entry point' '-------------------------------------------------------------Sub main Dim element as New MbeElement Dim filePos as Long Dim S$,FontNo as Integer 'read fence data from file Index = 0 Open "C:\Temp\ChgFnt.dat" For Input As 1 Do While Not Eof(1) Input #1,S FontNo = Val(S) Loop Close 'up to here ' read the first element filePos = element.fromFile (0) Do While filePos >= 0 If element.type = MBE_Text Then element.font = FontNo stat = element.rewrite(filePos, 0, 0) End If filePos = element.fromFile (filePos + element.fileSize) Loop End Sub

폴더를 선택하는 예제입니다. Dim MyBl As BrowseInfo Dim FList As Long Dim DirName As String Dim SelFolder As String DirName = Space(255) MyBl.sTitle = "Select Root Folder" MyBl.sDisplayName = Space(255) MyBl.ulFlags = Bif_ReturnOnlyFSDirs FList = SHBrowseForFolder(MyBl) SelFolder = SHGetPathFromIDList(FList, DirName) DirName = Left(DirName, InStr(1, DirName, Chr(0)) - 1) If DirName <> "" Then TextBoxFolder.Text = DirName Else TextBoxFolder.Text = "" End If

특정 요소의 Range가 잘못된 경우가 발생할 수 있습니다. 특히 3rd party 프로그램에서 생성된 파일일 경우.. 이때 Range를 수정하는 명령이 있습니다. mdl load fixrange filedesign 특정 폴더 안의 도면에 대해서 위 명령을 수행하는 매크로를 만들어 보겠습니다. Sub main() Dim S$ Dim One_File_List as String MbeSendCommand "mdl load fixrange" One_File_List = Dir$("C:\Temp" + "\*.*") Do While One_File_List <> "" MbeSendCommand "newfile " + One_File_List$ MbeSendCommand "filedesign" One_File_List = Dir$ Loop Close 'up to here End Sub

주어진 정점으로 이루어진 Polygon을 해칭하는 예제입니다. inData는 "HATCHPLINE,0,0,0.1,0,0.1,0.1,0,0.1,0,0," 이런식으로 주어지면 됩니다. Private Sub drawHatchPline(ByVal inData As String) Dim m_oShapeElement As ShapeElement Dim m_Points() As Point3d Dim ptrn As CrossHatchPattern Dim vertices() As Point3d Dim tokens() As String Dim i As Integer, index As Integer index = 0 tokens = Split(inData, ",") ReDim Preserve m_Points(UBound(tokens) / 2) For i = 1 To UBound(tokens) m_Points(index) = Point3dFromXY(Val(tokens(i)), Val(tokens(i + 1))) i = i + 1 index = index + 1 Next Set m_oShapeElement = CreateShapeElement1(msv8Element, m_Points, msdFillModeNotFilled) ActiveModelReference.AddElement m_oShapeElement ' Use a CrossHatchPattern object to set up the parameters for ' the hatching operation. Set ptrn = CreateCrossHatchPattern(0.01, 0.01, Pi / 4, -Pi / 4) ver...

선택한 Text의 정보를 출력하는 예제입니다. Sub DisplaySelTextElement() Dim cim As CadInputMessage Dim oEnumerator As ElementEnumerator If Not ActiveModelReference.AnyElementsSelected Then ShowError "The macro requires a selection set" Exit Sub End If Set oEnumerator = ActiveModelReference.GetSelectedElements Do While oEnumerator.MoveNext Dim oElement As Element Set oElement = oEnumerator.Current If oElement.Type = msdElementTypeText Then ShowStatus oElement.AsTextElement.Text End If Loop End Sub

아래 예제는 현재 열려 있는 모델의 요소에 접근하여 Range를 구하는 매크로 입니다. Sub EnumElements() Dim oScanEnumerator As ElementEnumerator Dim oElement As Element Set oScanEnumerator = ActiveModelReference.Scan Do While oScanEnumerator.MoveNext Set oElement = oScanEnumerator.Current If oElement.IsGraphical Then ShowStatus "Low = " & oElement.Range.Low.X & "," & oElement.Range.Low.Y ShowStatus "High= " & oElement.Range.High.X & "," & oElement.Range.High.Y End If Loop End Sub

VBA 교육은 하지 않는 것으로 결정이 났습니다. 앞으로 VBA 관련 업데이트는 자주 없을것 같습니다. 자 이제 LineString을 그리는 매크로를 작성해 보도록 합시다. 전체 소스는 아래와 같습니다. Sub Macro1() Dim startPoint As Point3d Dim point As Point3d, point2 As Point3d 'Start a command CadInputQueue.SendCommand "PLACE SMARTLINE " 'Coordinates are in master units startPoint.X = 7.316122 startPoint.Y = -4.865692 startPoint.Z = 0# 'Send a data point to the current command point = startPoint CadInputQueue.SendDataPoint point, 1 'Send a data point to the current command point.X = startPoint.X + 2.48087 point.Y = startPoint.Y + 3.0765 point.Z = startPoint.Z CadInputQueue.SendDataPoint point, 1 'Send a data point to the current command point.X = startPoint.X + 7.6503 point.Y = startPoint.Y + 1.9341 point.Z = startPoint.Z CadInputQueue.SendDataPoint point, 1 'Send a reset to the current command CadInputQueue.SendRes...

앞서 생성한 Sample1 프로젝트에 매크로 기록하는 것을 알아보겠습니다. 이 부분은 솔직히 설명할 것도 없습니다. 먼저 Sample1 프로젝트를 선택하시고, Start Record 버튼을 누릅니다. 예제로 선,사각형,원을 그려보겠습니다. 그리고 모두 선택한후 Ctrl+G를 눌러 Cell로 만들어 보겠습니다. 일련의 행동을 마쳤으면, Stop Record 버튼을 눌러 레코딩을 종료합니다. 이로써 하나의 매크로를 생성하였습니다. 생성한 매크로를 실행할려면, Macros 버튼을 눌러 생성한 매크로를 실행시키면 됩니다. 아래에 우리가 생성한 Macro1이라는 매크로가 보이죠? Run 버튼을 눌러 실행시키면 됩니다.

이 글은 외부 교육이 예정되어 있어 교육 준비 차원에서 작성한 글입니다. 맨 먼저 VBA 프로젝트를 생성하기 위해 아래 처럼 메뉴로 가서 프로젝트 관리자를 실행시킵니다. 프로젝트 관리자에서 오른쪽 버튼을 클릭하여 메뉴가 나타나면, New 항목을 선택합니다. 다이얼로그 박스가 나타나면 VBA 프로젝트를 생성할 폴더와 프로젝트 이름을 입력합니다. 마침내 우리의 첫번째 VBA 프로젝트가 생성되었습니다.

사용자 입력 데이터 포인터를 구해 파일로 저장하는 매크로 입니다. Sub main Dim point1 as MbePoint Dim stat as Integer Dim view as Integer Dim ass as String MbeState.messages = 0 Call MbeWritePrompt ("Select input data point") ' wait for data or reset Call MbeGetInput (MBE_DataPointInput, MBE_ResetInput) if MBE_Success = MbeState.getInputDataPoint (point1, view) then ass = Format$(point1.x , "#0.0#") & "," & Format$(point1.y , "#0.0#") & "," & Format$(point1.z , "#0.0#") Open "c:\inputdatapoint.dat" For Output Access Write Lock Write As #1 Write #1,ass Close end if Call MbeWritePrompt ("finished") End Sub