skalskibukowa Posted April 20, 2016 Posted April 20, 2016 (edited) Hi Guys, I have a liitle problem yesterday i wrote program which, drawing my figure in 3d and also doing rectangular 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 AcadDocument Dim AcadApp As AcadApplication Set AcadApp = ThisDrawing.Application Set objAcadDoc = AcadApp.Documents.Add Set StartNewAutoCADfile = objAcadDoc a = Val(TextBox14) b = Val(TextBox15) c = Val(TextBox16) d = Val(TextBox17) e = Val(TextBox18) pi = 4 * Atn(1) px = 100 py = 100 pz = 0 Dim k1(0 To 2) As Double k1(0) = px k1(1) = py k1(2) = pz k2 = 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, k2 ThisDrawing.ModelSpace.AddLine k2, k7 ThisDrawing.ModelSpace.AddLine k7, k8 ThisDrawing.ModelSpace.AddLine k8, k1 ThisDrawing.ModelSpace.AddLine k3, k4 ThisDrawing.ModelSpace.AddLine k4, k5 ThisDrawing.ModelSpace.AddLine k5, k6 ThisDrawing.ModelSpace.AddLine k6, k3 Dim l1(0 To 2) As Double l1(0) = px l1(1) = py l1(2) = pz + e With ThisDrawing.Utility L2 = .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 With With ThisDrawing.ModelSpace .AddLine L2, L3 .AddLine L3, L6 .AddLine L6, L7 .AddLine L7, L2 End With Dim m1(0 To 2) As Double m1(0) = px m1(1) = py m1(2) = pz + b - e - d With ThisDrawing.Utility m2 = .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 With With ThisDrawing.ModelSpace .AddLine m2, m3 .AddLine m3, m6 .AddLine m6, m7 .AddLine m7, m2 End With Dim n1(0 To 2) As Double n1(0) = px n1(1) = py n1(2) = pz + b With ThisDrawing.Utility n2 = .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 With With 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, n3 End With With 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, n7 End With 'Set AcadApp = ThisDrawing.Application Set objAcadDoc = AcadApp.Documents.Add Set StartNewAutoCADfile = objAcadDoc Dim s1(0 To 2) As Double s1(0) = px s1(1) = py s1(2) = pz S2 = 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 AcadLine Set 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 10 L(n).Lineweight = acLnWt050 Next n Dim Odl1(0 To 2) As Double Odl1(0) = S2(0) Odl1(1) = S2(1) + 20 Odl1(2) = 0 ThisDrawing.ModelSpace.AddDimAligned s1, s4, Odl1 Dim Odl2(0 To 2) As Double Odl2(0) = s1(0) - 20 Odl2(1) = s1(1) Odl2(2) = 0 ThisDrawing.ModelSpace.AddDimAligned s1, s8, Odl2 Dim o13(0 To 2) As Double o13(0) = px o13(1) = py - 50 o13(2) = pz o14 = 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 22 L(n).Lineweight = acLnWt050 Next n Dim Odl3(0 To 2) As Double Odl3(0) = o13(0) - 20 Odl3(1) = o13(1) Odl3(2) = 0 ThisDrawing.ModelSpace.AddDimAligned o13, o24, Odl3 Dim c1(0 To 2) As Double c1(0) = px + 200 c1(1) = py + 10 c1(2) = pz c2 = 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 30 L(n).Lineweight = acLnWt050 Next n Dim Odl4(0 To 2) As Double Odl4(0) = c2(0) + 20 Odl4(1) = c2(1) Odl4(2) = 0 ThisDrawing.ModelSpace.AddDimAligned c2, c3, Odl4 Dim Odl5(0 To 2) As Double Odl5(0) = c4(0) + 20 Odl5(1) = c4(1) Odl5(2) = 0 ThisDrawing.ModelSpace.AddDimAligned c4, c5, Odl5 ZoomAll ThisDrawing.SetVariable "LWDISPLAY", 1 End Sub Edited April 21, 2016 by skalskibukowa Quote
BIGAL Posted April 21, 2016 Posted April 21, 2016 Simple the variable CELTYPE holds current line type style set before adding a line. Quote
SLW210 Posted April 21, 2016 Posted April 21, 2016 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. Quote
skalskibukowa Posted April 21, 2016 Author Posted April 21, 2016 Can you show me how should it looks? Can you write it? i have found something on net like this but when i used it for this points show me still Error..... 1.Dim DashedLine As AcadLineType 2.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 question I dont like programming but engineering studies require from me knowledge of this program Quote
skalskibukowa Posted April 21, 2016 Author Posted April 21, 2016 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 !!! Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.