Jump to content

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


skalskibukowa
 Share

Recommended Posts

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 by skalskibukowa
Link to comment
Share on other sites

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 :D I dont like programming but engineering studies require from me knowledge of this program :(

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...