[VBA] How to connect two point
Hi Guys,I have a liitle problem yesterday i wrote program which, drawing my figure in 3d and also doingrectangular projection and the problem is that i dont know how to connect two points by "DashedLine". Can you help me? I tried a lot of way, but every time i have some Error.....
Below i paste my program
Private Sub Rysuj_Click()Dim objAcadDoc As AcadDocumentDim AcadApp As AcadApplicationSet AcadApp = ThisDrawing.ApplicationSet objAcadDoc = AcadApp.Documents.AddSet StartNewAutoCADfile = objAcadDoca = Val(TextBox14)b = Val(TextBox15)c = Val(TextBox16)d = Val(TextBox17)e = Val(TextBox18)pi = 4 * Atn(1)px = 100py = 100pz = 0Dim k1(0 To 2) As Doublek1(0) = pxk1(1) = pyk1(2) = pzk2 = ThisDrawing.Utility.PolarPoint(k1, 0, a)k3 = ThisDrawing.Utility.PolarPoint(k2, 0, c)k4 = ThisDrawing.Utility.PolarPoint(k3, 0, a)k5 = ThisDrawing.Utility.PolarPoint(k4, pi / 2, a)k6 = ThisDrawing.Utility.PolarPoint(k5, pi, a)k7 = ThisDrawing.Utility.PolarPoint(k6, pi, c)k8 = ThisDrawing.Utility.PolarPoint(k7, pi, a)ThisDrawing.ModelSpace.AddLine k1, k2ThisDrawing.ModelSpace.AddLine k2, k7ThisDrawing.ModelSpace.AddLine k7, k8ThisDrawing.ModelSpace.AddLine k8, k1ThisDrawing.ModelSpace.AddLine k3, k4ThisDrawing.ModelSpace.AddLine k4, k5ThisDrawing.ModelSpace.AddLine k5, k6ThisDrawing.ModelSpace.AddLine k6, k3Dim l1(0 To 2) As Doublel1(0) = pxl1(1) = pyl1(2) = pz + eWith ThisDrawing.UtilityL2 = .PolarPoint(l1, 0, a)L3 = .PolarPoint(L2, 0, c)L4 = .PolarPoint(L3, 0, a)L5 = .PolarPoint(L4, pi / 2, a)L6 = .PolarPoint(L5, pi, a)L7 = .PolarPoint(L6, pi, c)L8 = .PolarPoint(L7, pi, a)End WithWith ThisDrawing.ModelSpace.AddLine L2, L3.AddLine L3, L6.AddLine L6, L7.AddLine L7, L2End WithDim m1(0 To 2) As Doublem1(0) = pxm1(1) = pym1(2) = pz + b - e - dWith ThisDrawing.Utilitym2 = .PolarPoint(m1, 0, a)m3 = .PolarPoint(m2, 0, c)m4 = .PolarPoint(m3, 0, a)m5 = .PolarPoint(m4, pi / 2, a)m6 = .PolarPoint(m5, pi, a)m7 = .PolarPoint(m6, pi, c)m8 = .PolarPoint(m7, pi, a)End WithWith ThisDrawing.ModelSpace.AddLine m2, m3.AddLine m3, m6.AddLine m6, m7.AddLine m7, m2End WithDim n1(0 To 2) As Doublen1(0) = pxn1(1) = pyn1(2) = pz + bWith ThisDrawing.Utilityn2 = .PolarPoint(n1, 0, a)n3 = .PolarPoint(n2, 0, c)n4 = .PolarPoint(n3, 0, a)n5 = .PolarPoint(n4, pi / 2, a)n6 = .PolarPoint(n5, pi, a)n7 = .PolarPoint(n6, pi, c)n8 = .PolarPoint(n7, pi, a)End WithWith ThisDrawing.ModelSpace.AddLine n1, n2.AddLine n2, n7.AddLine n7, n8.AddLine n8, n1.AddLine n3, n4.AddLine n4, n5.AddLine n5, n6.AddLine n6, n3End WithWith ThisDrawing.ModelSpace.AddLine k1, n1.AddLine k8, n8.AddLine k2, L2.AddLine m2, n2.AddLine k3, L3.AddLine m3, n3.AddLine m6, n6.AddLine k4, n4.AddLine k5, n5.AddLine k7, L7.AddLine k6, L6.AddLine m7, n7End With'Set AcadApp = ThisDrawing.ApplicationSet objAcadDoc = AcadApp.Documents.AddSet StartNewAutoCADfile = objAcadDocDim s1(0 To 2) As Doubles1(0) = pxs1(1) = pys1(2) = pzS2 = ThisDrawing.Utility.PolarPoint(s1, 0, a)s3 = ThisDrawing.Utility.PolarPoint(S2, 0, c)s4 = ThisDrawing.Utility.PolarPoint(s3, 0, a)s5 = ThisDrawing.Utility.PolarPoint(s4, pi / 2, a)s6 = ThisDrawing.Utility.PolarPoint(s5, pi, a)s7 = ThisDrawing.Utility.PolarPoint(s6, pi, c)s8 = ThisDrawing.Utility.PolarPoint(s7, pi, a)Dim L(100) As AcadLineSet L(1) = ThisDrawing.ModelSpace.AddLine(s1, S2)Set L(2) = ThisDrawing.ModelSpace.AddLine(S2, s3)Set L(3) = ThisDrawing.ModelSpace.AddLine(S2, s7)Set L(4) = ThisDrawing.ModelSpace.AddLine(s6, s7)Set L(5) = ThisDrawing.ModelSpace.AddLine(s7, s8)Set L(6) = ThisDrawing.ModelSpace.AddLine(s8, s1)Set L(7) = ThisDrawing.ModelSpace.AddLine(s3, s4)Set L( = ThisDrawing.ModelSpace.AddLine(s4, s5)Set L(9) = ThisDrawing.ModelSpace.AddLine(s5, s6)Set L(10) = ThisDrawing.ModelSpace.AddLine(s6, s3)For n = 1 To 10L(n).Lineweight = acLnWt050Next nDim Odl1(0 To 2) As DoubleOdl1(0) = S2(0)Odl1(1) = S2(1) + 20Odl1(2) = 0ThisDrawing.ModelSpace.AddDimAligned s1, s4, Odl1Dim Odl2(0 To 2) As DoubleOdl2(0) = s1(0) - 20Odl2(1) = s1(1)Odl2(2) = 0ThisDrawing.ModelSpace.AddDimAligned s1, s8, Odl2Dim o13(0 To 2) As Doubleo13(0) = pxo13(1) = py - 50o13(2) = pzo14 = ThisDrawing.Utility.PolarPoint(o13, 0, a)o15 = ThisDrawing.Utility.PolarPoint(o14, 3 / 2 * pi, d)o16 = ThisDrawing.Utility.PolarPoint(o15, 0, c)o17 = ThisDrawing.Utility.PolarPoint(o16, pi / 2, d)o18 = ThisDrawing.Utility.PolarPoint(o17, 0, a)o19 = ThisDrawing.Utility.PolarPoint(o18, 3 / 2 * pi, b)o20 = ThisDrawing.Utility.PolarPoint(o19, pi, a)o21 = ThisDrawing.Utility.PolarPoint(o20, pi / 2, e)o22 = ThisDrawing.Utility.PolarPoint(o21, pi, c)o23 = ThisDrawing.Utility.PolarPoint(o22, 3 / 2 * pi, e)o24 = ThisDrawing.Utility.PolarPoint(o23, pi, a)Set L(11) = ThisDrawing.ModelSpace.AddLine(o13, o14)Set L(12) = ThisDrawing.ModelSpace.AddLine(o14, o15)Set L(13) = ThisDrawing.ModelSpace.AddLine(o15, o16)Set L(14) = ThisDrawing.ModelSpace.AddLine(o16, o17)Set L(15) = ThisDrawing.ModelSpace.AddLine(o17, o18)Set L(16) = ThisDrawing.ModelSpace.AddLine(o18, o19)Set L(17) = ThisDrawing.ModelSpace.AddLine(o19, o20)Set L(18) = ThisDrawing.ModelSpace.AddLine(o20, o21)Set L(19) = ThisDrawing.ModelSpace.AddLine(o21, o22)Set L(20) = ThisDrawing.ModelSpace.AddLine(o22, o23)Set L(21) = ThisDrawing.ModelSpace.AddLine(o23, o24)Set L(22) = ThisDrawing.ModelSpace.AddLine(o24, o13)For n = 11 To 22L(n).Lineweight = acLnWt050Next nDim Odl3(0 To 2) As DoubleOdl3(0) = o13(0) - 20Odl3(1) = o13(1)Odl3(2) = 0ThisDrawing.ModelSpace.AddDimAligned o13, o24, Odl3Dim c1(0 To 2) As Doublec1(0) = px + 200c1(1) = py + 10c1(2) = pzc2 = ThisDrawing.Utility.PolarPoint(c1, 0, a)c3 = ThisDrawing.Utility.PolarPoint(c2, 3 / 2 * pi, d)c4 = ThisDrawing.Utility.PolarPoint(c3, 3 / 2 * pi, b - (d + e))c5 = ThisDrawing.Utility.PolarPoint(c4, 3 / 2 * pi, e)c6 = ThisDrawing.Utility.PolarPoint(c5, pi, a)c7 = ThisDrawing.Utility.PolarPoint(c6, 1 / 2 * pi, e)c8 = ThisDrawing.Utility.PolarPoint(c7, 1 / 2 * pi, b - (d + e))Set L(23) = ThisDrawing.ModelSpace.AddLine(c1, c2)Set L(24) = ThisDrawing.ModelSpace.AddLine(c2, c3)Set L(25) = ThisDrawing.ModelSpace.AddLine(c3, c4)Set L(26) = ThisDrawing.ModelSpace.AddLine(c4, c5)Set L(27) = ThisDrawing.ModelSpace.AddLine(c5, c6)Set L(28) = ThisDrawing.ModelSpace.AddLine(c6, c7)Set L(29) = ThisDrawing.ModelSpace.AddLine(c7, c8)Set L(30) = ThisDrawing.ModelSpace.AddLine(c8, c1)ThisDrawing.ModelSpace.AddLine c3, c8 ------------------- i want connect this points by "DashedLine" !!!!:roll: ThisDrawing.ModelSpace.AddLine c4, c7 ---------- and this points connect by "DashedLine" !!!!:roll::roll:For n = 23 To 30L(n).Lineweight = acLnWt050Next nDim Odl4(0 To 2) As DoubleOdl4(0) = c2(0) + 20Odl4(1) = c2(1)Odl4(2) = 0ThisDrawing.ModelSpace.AddDimAligned c2, c3, Odl4Dim Odl5(0 To 2) As DoubleOdl5(0) = c4(0) + 20Odl5(1) = c4(1)Odl5(2) = 0ThisDrawing.ModelSpace.AddDimAligned c4, c5, Odl5ZoomAllThisDrawing.SetVariable "LWDISPLAY", 1End Sub Simple the variable CELTYPE holds current line type style set before adding a line. I moved your thread to the .NET, ObjectARX & VBA Forum, please post in the appropriate forum.
Please read the Code Posting Guidelines and edit your post to include the Code in Code Tags. Can you show me how should it looks? Can you write it? i have foundsomething on net like this but when i used it for this points show me still Error.....
1.Dim DashedLine AsAcadLineType2.ThisDrawing.Linetypes.Load "Dashed", "acad.lin"3.Set DashedLine = _ThisDrawing.Linetypes.Item ( instead of "item" i change for two my two points and when i run macro ,here stop my programme and show me that it is Error )4. ThisDrawing.ActiveLinetype= DashedLine
P.S. I am new in Vba Acad so i am sorry for my stupid questionI dont like programming butengineering studies require from me knowledge of this program I am figure nice idea look it works O.o
Dim entry As AcadLineType Dim found As Boolean found = False For Each entry In ThisDrawing.Linetypes If StrComp(entry.Name, "Kreskowa", 1) = 0 Then found = True Exit For End If Next If Not (found) Then ThisDrawing.Linetypes.Load "Kreskowa", "acad.lin" ' Create the line Dim lineObj(2) As AcadLine Dim startPoint(0 To 2) As Double Dim endPoint(0 To 2) As Double startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0# endPoint(0) = 4#: endPoint(1) = 4#: endPoint(2) = 0# Set lineObj(1) = ThisDrawing.ModelSpace.AddLine(c3, c8) Set lineObj(2) = ThisDrawing.ModelSpace.AddLine(c4, c7) ' Change the linetype of the line lineObj(1).Linetype = "Kreskowa" lineObj(2).Linetype = "Kreskowa"
PS. Im from Poland so "Kreskowa" means "Dashed". Thanks a lot for your attention. Thread is closed !!!
页:
[1]