프로그램
캐드 분류

세점 포물선 그리기 VBA

컨텐츠 정보

본문

2차 포물선 그리기 VBA입니다.

(이미지 추가가 여의치 않아 블로그 링크합니다.)
코드입니다.
Sub para()
    Dim Pnt1, Pnt2, Pnt3 As Variant '3points for parabola
    Pnt1 = ThisDrawing.Utility.GetPoint(, "1st Point")
    Pnt2 = ThisDrawing.Utility.GetPoint(, "2nd Point")
    Pnt3 = ThisDrawing.Utility.GetPoint(, "3rd Point")
    Dim a, b, c As Double
    Dim M11, M12, M13, M21, M22, M23, M31, M32, M33 As Double 
    Dim x1, x2, x3, y1, y2, y3, plusx, plusy As Double
    plusx = Pnt1(0) + Pnt3(0)
    plusy = Pnt1(1) + Pnt3(1)
    x1 = Pnt1(0) + plusx: x2 = Pnt2(0) + plusx: x3 = Pnt3(0) + plusx
    y1 = Pnt1(1) + plusy: y2 = Pnt2(1) + plusy: y3 = Pnt3(1) + plusy
    M11 = 1 / (x1 ^ 2 – x1 * x2 – x1 * x3 + x2 * x3)
    M12 = 1 / (x2 ^ 2 – x1 * x2 + x1 * x3 – x2 * x3)
    M13 = 1 / (x3 ^ 2 + x1 * x2 – x1 * x3 – x2 * x3)
    M21 = -(x2 + x3) / (x1 ^ 2 – x1 * x2 – x1 * x3 + x2 * x3)
    M22 = -(x1 + x3) / (x2 ^ 2 – x1 * x2 + x1 * x3 – x2 * x3)
    M23 = -(x1 + x2) / (x3 ^ 2 + x1 * x2 – x1 * x3 – x2 * x3)
    M31 = -(x1 * x3) * (x2 ^ 2 – x2 * x3) / (x1 ^ 2 – x1 * x3) / (x2 ^ 2 – x1 * x2 + x1 * x3 – x2 * x3)
    M32 = (x1 * x3) / (x2 ^ 2 – x1 * x2 + x1 * x3 – x2 * x3)
    M33 = -(x1 * x3) * (x2 ^ 2 – x1 * x2) / (x3 ^ 2 – x1 * x3) / (x2 ^ 2 – x1 * x2 + x1 * x3 – x2 * x3)
    a = M11 * y1 + M12 * y2 + M13 * y3
    b = M21 * y1 + M22 * y2 + M23 * y3
    c = M31 * y1 + M32 * y2 + M33 * y3
    Dim n As Integer '등분'
        n = InputBox("What is the number of divided parabola?")
    Dim interval As Double
        interval = (x3 – x1) / n
    Dim polyPnt() As Double
    ReDim polyPnt(2 * n + 1) As Double
    Dim i As Integer
    For i = 0 To n
        polyPnt(i * 2) = x1 + interval * i
        polyPnt(i * 2 + 1) = a * polyPnt(i * 2) ^ 2 + b * polyPnt(i * 2) + c
    Next i
    Dim Opnt1(2) As Double
    Dim Opnt2(2) As Double
        Opnt1(0) = 0: Opnt1(1) = 0: Opnt1(2) = 0
        Opnt2(0) = -plusx: Opnt2(1) = -plusy: Opnt2(2) = 0
    Dim polyObj As AcadLWPolyline
    Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(polyPnt)
        polyObj.Move Opnt1, Opnt2
End Sub

관련자료

댓글 0
등록된 댓글이 없습니다.
여분필드1 여분필드2 여분필드3
전체 59 / 1 페이지
번호
제목
이름
알림 0