[VBA] How to connect two points "DashedLine" ?

[skalskibukowa]

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

[BIGAL]

Simple the variable CELTYPE holds current line type style set before adding a line.

[SLW210]

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.

[skalskibukowa]

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

[skalskibukowa]

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 !!!