캐드 분류
강연선 정착부 배치 VBA
컨텐츠 정보
- 193 조회
- 0 추천
- 0 비추천
- 목록
본문
직선을 가지는 강연선 배치 VBA입니다.
(이미지 추가가 여의치 않아서 블로그 링크시켰습니다)
Sub te1()
Dim Pnt1, Pnt2, Pnt3 As Variant '3points
Pnt1 = ThisDrawing.Utility.GetPoint(, "1st Point")
Pnt2 = ThisDrawing.Utility.GetPoint(, "2nd Point")
Pnt3 = ThisDrawing.Utility.GetPoint(, "3rd Point")
Dim a, b, c As Double
a = Pnt3(0) – Pnt1(0)
b = Pnt2(0) – Pnt1(0)
c = Pnt1(1) – Pnt3(1)
Dim x, fx, fxd As Double
Dim i As Integer
x = c
For i = 0 To 10
fx = (x – b) ^ 2 – (x – a) ^ 2 + (b * c / x – c) ^ 2
fxd = -2 * b * c / (x * x * x) + 2 * c / (x * x) + 2 * a – 2 * b
x = x – fx / fxd
Next i
Pnt2(1) = -b * c / x + c + Pnt3(1)
Dim circlePnt(2) As Double
Dim circleR As Double
circlePnt(0) = Pnt3(0)
circlePnt(1) = x / c * a – b * c / x + c – b * x / c + Pnt3(1)
circleR = Abs(circlePnt(1) – Pnt3(1))
Dim lineObj As AcadLine
Set lineObj = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)
Dim strA, endA As Double
If circlePnt(1) > Pnt1(1) Then
strA = Atn(x / c) + 3.14159265358979
endA = 3.14159265358979 * 1.5
Else
strA = 3.14159265358979 * 0.5
endA = Atn(x / c) – 3.14159265358979
End If
Dim arcObj As AcadArc
Set arcObj = ThisDrawing.ModelSpace.AddArc(circlePnt, circleR, strA, endA)
End Sub
관련자료
댓글 0
/ 1 페이지
등록된 댓글이 없습니다.
