logo

한국어

칼럼

    오늘:
    90
    어제:
    96
    전체:
    69,163

폴리라인을 G-code로 바꾸는 VBA

2015.01.07 21:54

com4uinc 조회 수:245

Public Sub PToG()
    Dim setPoly As AcadSelectionSet
    Dim filVar(0 To 0) As Integer
    Dim filType(0 To 0) As Variant
    Dim dataCol As Collection
    Set dataCol = New Collection
    
    
    
    On Error Resume Next
    Open "c:/g-code.txt" For Output As #1
    If Err.Number <> 0 Then
        Close #1
        Open "c:/g-code.txt" For Output As #1
    End If
    Set setPoly = ThisDrawing.SelectionSets.Add("TmpPoly")
    If Err.Number <> 0 Then
        ThisDrawing.SelectionSets.Item("TmpPoly").Delete
        Set setPoly = ThisDrawing.SelectionSets.Add("TmpPoly")
    End If
    On Error GoTo 0
    Err.Clear
    filVar(0) = 0
    filType(0) = "LWPolyLine"
    ThisDrawing.Utility.Prompt "Select Point"
    setPoly.SelectOnScreen filVar, filType
    
    
    If setPoly.Count = 0 Then
        MsgBox "선택된것이 없어서 종료합니다."
        Exit Sub
    End If
    
    Dim PolyObj As AcadLWPolyline
    Set PolyObj = setPoly(0)
    
    Dim tmppt1(0 To 2) As Double
    Dim polyVtx As Variant
    Dim polyBulge() As Double
    Dim polypt(0 To 2) As Double
    Dim tmpRadious As Double
    Dim outstring As String
    polyVtx = PolyObj.Coordinates
    Print #1, "X" & Format(polyVtx(0), "#.##0") & "Y" & Format(polyVtx(1), "#.##0")
    
    For i = 0 To UBound(polyVtx) - 3 Step 2
        polypt(0) = polyVtx(i)
        polypt(1) = polyVtx(i + 1)
        polypt(2) = 0
        
        tmppt1(0) = polyVtx(i + 2)
        tmppt1(1) = polyVtx(i + 3)
        tmppt1(2) = 0
        
        If 0 <> PolyObj.GetBulge(i / 2) Then
            tmppt = GetCenPtFromBulge(polypt, tmppt1, PolyObj.GetBulge(i / 2))
            tmpRadious = GetDistPt2Pt(polypt, tmppt)
            If 0 < PolyObj.GetBulge(i / 2) Then
                outstring = "G03X" & Format(tmppt1(0), "#.##0") & "Y" & Format(tmppt1(1), "#.##0") & "R" & Format(tmpRadious, "#.##0")
                Else
                outstring = "G02X" & Format(tmppt1(0), "#.##0") & "Y" & Format(tmppt1(1), "#.##0") & "R" & Format(tmpRadious, "#.##0")
            End If
            Else
            outstring = "G01X" & Format(tmppt1(0), "#.##0") & "Y" & Format(tmppt1(1), "#.##0")
        End If
        Print #1, outstring
    Next i
    
    Close #1
    
End Sub
Private Function GetCenPtFromBulge(StartPoint As Variant, EndPoint As Variant, Bulge As Double)
    Dim midpt As Variant
    Dim arcmidpt As Variant
    Dim fun As Variant
    Dim middist As Double
    Dim ptdist As Double
    Dim ptang As Double
    Dim addang As Variant
    Dim buldist As Double
    Dim Utility As AcadUtility
    
    
    Set Utility = ThisDrawing.Utility
    
    
    ptdist = GetDistPt2Pt(StartPoint, EndPoint)
    ptang = Utility.AngleFromXAxis(StartPoint, EndPoint)
    If Bulge = 0 Then
        addang = Null
        Else
        addang = ptang - Pi / 2
    End If
        
    
    Dim StartArcmidMidPt As Variant
    Dim StartArcmidAng As Double
    Dim StartArcmidDist As Double
    Dim StartArcmid90Pt As Variant
    Dim Aobj As AcadLine
    Dim Bobj As AcadLine
    If Not IsNull(addang) Then
        middist = ptdist / 2
        buldist = middist * Bulge
        midpt = Utility.PolarPoint(StartPoint, ptang, middist)
        arcmidpt = Utility.PolarPoint(midpt, addang, buldist)
        
        StartArcmidDist = GetDistPt2Pt(StartPoint, arcmidpt)
        StartArcmidAng = Utility.AngleFromXAxis(StartPoint, arcmidpt)
        StartArcmidMidPt = Utility.PolarPoint(StartPoint, StartArcmidAng, StartArcmidDist / 2)
        StartArcmid90Pt = Utility.PolarPoint(StartArcmidMidPt, StartArcmidAng + Pi / 2, StartArcmidDist)
        
        With ThisDrawing.ModelSpace
            Set Aobj = .AddLine(midpt, arcmidpt)
            Set Bobj = .AddLine(StartArcmidMidPt, StartArcmid90Pt)
        End With
        fun = Aobj.IntersectWith(Bobj, acExtendBoth)
        Aobj.Delete
        Bobj.Delete
        Else
        fun = Null
    End If
    GetCenPtFromBulge = fun
End Function
Private Function GetDistPt2Pt(pt1 As Variant, pt2 As Variant) As Double
'''2점간의 거리
    GetDistPt2Pt = Sqr((pt2(0) - pt1(0)) ^ 2 + (pt2(1) - pt1(1)) ^ 2)
End Function
Public Function GetAnglePt2Pt(pt1 As Variant, pt2 As Variant) As Double
'''두점간의 각도
'''GetDistPt2Pt 함수 있어야 함.
    GetAnglePt2Pt = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)
End Function
Public Function Pi() As Double
'
' Abstract -    Calculates Pi.
'
' Parameters
'   none.
'
' Return Value
'   Pi.
'
' R0        31 Jul 98   MichaelHu
'
    On Error GoTo ERR_HANDLER
    Pi = 4 * Atn(1)

EXIT_PT:
    Exit Function

ERR_HANDLER:
    Err.Raise Err.Number, "CadServices:Pi", Err.Description
    Resume EXIT_PT
End Function