TheSwamp
Code Red => VB(A) => Topic started by: ELOQUINTET on December 21, 2006, 01:29:28 PM
-
We use the vba routine posted below to draw reflected views based on the sections. Until now every line was being put on layer zero but I have been trying to incorporate layers into it. Right now i have a single shade assembly on shade1 layer and the lines for a second shade in a double shade assembly on a shade2 layer. i also have items on a fascia layer and dims on a dimensions layer. i grouped the items together by going through the code and just numbering the layers in order shade1 shade 2 etc. then i drew different scenarios and used a routine i got here to label what layer each line was being put on the i put them on the right layers. i still have a few lines whose layers i have not allocated yet but it is pretty complete. i wanted to show everyone what i have been doing and maybe this will explain why i have been looking for all of these layer lisps. my boss uses groups alot ecspecially when we do complicated assemblies so i am trying to figure out how i can incorporate that option into the routine. i would like to be able to choose this as an option in the dialogue because some people may like to use groups or not or the assembly may not require it and i don't want unneccessary groups. so i was thinking it could maybe create a shade# group then the next one would increment. i partially wanted to show everyone one of our custom routines and get input/suggestions on how we might improve it.
http://www.theswamp.org/lilly_pond/index.php?dir=dan/&file=CRACKED%20reflected.dvb
-
o yeah i knew i was forgetting about something. one of the things i also would like to work on is how to create the centerlines in a different manner so as they can be grouped with per shade. also the cyan lines which illustrate the shade roll are all on shade1 layer but sometimes the roll lines need to be shown on the second shade assembly as well but i want to be able to associate them with one or the other. does this make any sense?
-
i see this is the part in the code where he is creating the roll lines but not sure how to make one for each shade assembly?
Private Sub HatchTube(k1, k2 As Variant, Dist As Double, angle As Double)
Dim i As Single
Dim delta As Single
Dim T_line As AcadLine
Dim K3 As Variant
Dim k4 As Variant
Dim sum As Single
i = 1
K3 = TDU.PolarPoint(k1, angle, 0#)
k4 = TDU.PolarPoint(k2, angle, 0#)
sum = 0#
Do While delta < Dist - (sum + 2 * delta)
delta = i * 1 / 16
sum = sum + delta
K3 = TDU.PolarPoint(K3, angle, delta)
k4 = TDU.PolarPoint(k4, angle, delta)
Set T_line = ActSpc.AddLine(K3, k4)
T_line.Layer = "SHADE1"
T_line.color = acCyan
T_line.Linetype = "continuous"
i = i + 1
If i > 3 Then i = i + 0.5
Loop
End Sub
-
and i see the bit for the centerlines but again how do i make one for each assembly
Private Sub DrawCLines(Trans As Variant)
Dim Cline1(0 To 0) As AcadObject
Dim lclStartPoint As Variant
Dim lclEndPoint As Variant
Set Cline1(0) = ActSpc.AddPolyline(Trans)
Cline1(0).Layer = "SHADE1"
Cline1(0).color = acGreen
Cline1(0).Linetype = "CENTER"
End Sub
-
o yeah the guy who wrote the program intended to incorporate notes into it as well which he started at the end but never finished. another part which was never incorporated was putting in the brackets which would be nice but these are bonuses that may come later
-
Dan, perhaps it would help if you include a dwg to use the dvb on. fascia layer , assembly etc are all a foreign language to me, whereas the dvb doesnt look too complicated but long winded.
As far as the centerline, if you dim an integer on the module level and increment it for each assembly, then you can put it on a new layer
Cline1(0).Layer =thisdrawing.layers.add("SHADE" & intAssembly)
Weirdly you can add a layer even if the layer exists, it doesn't error out.
-
thanks Bryco attached are examples of what we do with the program. On the left you will see a section view of a shade assembly. Basically it draws reflected views of various assemblies based on user input. i was using this drawing to label the different lines/layers so i could put subassemblies on given layers?
http://www.theswamp.org/lilly_pond/index.php?dir=dan/&file=reflected%20examples.dwg
-
HOLY FREAKIN' CRAP!!!
None of your layers have colors set ByLayer!!
-
ha yeah i know Matt imagine how shocked I was when I started working here. They didn't use layers at all or it was very limited. We just changed colors according to how we want to present it. I was originally trying to put each element on it's own layer and make it's color bylayer but my boss was not having it. She has a problem with layers for some reason. I tried to fight it but ultimately she is the boss so what can I do. So anyway does the purpose of this routine make sense now? Bryco forgive me I'm very new at VBA so where/how do I incorporate this bit into it. Also is an option to create groups based on layer feasible and what level of complication are we talking about? Thanks guys
-
o yeah by the way matt i only created all the layers as identifiers between what was being drawn vs. what was in the code so i could "group" parts together. i have now narrowed it down to a shade1, shade2, fascia, and dimensions layer which covers everything.
-
Dan, I looked at the drawing and I can't find a relationship for the shade numbers you want.
Are the centerlines always on shade1 or 2?
You have sequential drawings 1 to 28 yet none of layers seem to correspond to the drawing number.
The red lines seem to relate to the diameter of the roll but the top and bot red lines seem to have a differnet number.
-
ok i see i need to explain a little more. the drawing i uploaded contains different scenarios for 2-1/2" dia. tubes i believe. first group contains assemblies using custom stamping picked from upper right of dialogue. then i did an idle end a center support then a drive end detail of each. then i did a drawing which contained som accesories like fascia/ tile support. then i drew the same idle center and drive details for a double shade assembly. then i repeated this process for the manual stamping the electro1/2 then the electro extended stamping. i also have a couple more drawings which have scenarios for other tubes but it follows the same logic. does this make any sense? if i have a double shade assembly one centerline would be on the shade1 layer and another on the shade2 layer. and the same goes for the cyan shade roll lines. let me know if this is making sense to anyone as i draw this stuff all day so the terms are familiar to me.
-
First change the DrawCLines sub to include a string argument that provides the layer name
Private Sub DrawCLines(Trans As Variant, sLayer As String)
Dim Cline1(0 To 0) As AcadObject
Dim lclStartPoint As Variant
Dim lclEndPoint As Variant
Set Cline1(0) = ActSpc.AddPolyline(Trans)
Cline1(0).Layer = sLayer
Cline1(0).color = acGreen
Cline1(0).Linetype = "CENTER"
End Sub
Then use Find to find all the occurences of DrawCLines
and add either "Shade1" or "Shade2" where appropriate.
If ThisDrawing.IsSingleShade Then
If ThisDrawing.IsCS Then ' center support single shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Translate(0) = CLP2(0)
Translate(1) = CLP2(1)
Translate(2) = CLP2(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Else ' end condition single shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP2(0)
Translate(4) = CLP2(1)
Translate(5) = CLP2(2)
DrawCLines Translate, "Shade1"
End If
Else
If ThisDrawing.IsCS Then ' center support double shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Translate(0) = CLP2(0)
Translate(1) = CLP2(1)
Translate(2) = CLP2(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Translate(0) = CLP4(0)
Translate(1) = CLP4(1)
Translate(2) = CLP4(2)
Translate(3) = CLP6(0)
Translate(4) = CLP6(1)
Translate(5) = CLP6(2)
DrawCLines Translate, "Shade2"
Translate(0) = CLP5(0)
Translate(1) = CLP5(1)
Translate(2) = CLP5(2)
Translate(3) = CLP6(0)
Translate(4) = CLP6(1)
Translate(5) = CLP6(2)
DrawCLines Translate, "Shade2"
Else ' end condition double shade
code]
-
I personly hate 2dPolylines and the code shown is not a good introduction to vba.
If one is making a whole lot of polarpoints then they may as well be passed directly to the sub instead of doubling up on the code
Dim Ang As Double
Ang = MainAngle - (Pi / 2)
CLP1 = TDU.PolarPoint(M1, Ang, D1)
CLP2 = TDU.PolarPoint(M2, Ang, D1)
CLP3 = TDU.PolarPoint(M3, Ang, D1)
CLP4 = TDU.PolarPoint(M1, Ang, D2)
CLP5 = TDU.PolarPoint(M2, Ang, D2)
CLP6 = TDU.PolarPoint(M3, Ang, D2)
If ThisDrawing.IsSingleShade Then
If ThisDrawing.IsCS Then ' center support single shade
DrawCLines CLP1, CLP3, "Shade1"
DrawCLines CLP2, CLP3, "Shade1"
Else ' end condition single shade
DrawCLines CLP1, CLP2, "Shade1"
End If
Else
If ThisDrawing.IsCS Then ' center support double shade
DrawCLines CLP1, CLP3, "Shade1"
DrawCLines CLP2, CLP3, "Shade1"
DrawCLines CLP4, CLP6, "Shade2"
DrawCLines CLP5, CLP6, "Shade2"
Else ' end condition double shade
DrawCLines CLP1, CLP6, "Shade1"
DrawCLines CLP4, CLP5, "Shade2"
End If
End If
Private Sub DrawCLines(StartPoint As Variant, EndPoint As Variant, sLayer As String)
Dim Cline1 As AcadLWPolyline
Dim Pts(3) As Double
Pts(0) = StartPoint(0): Pts(1) = StartPoint(1)
Pts(2) = EndPoint(0): Pts(3) = EndPoint(1)
Set Cline1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(Pts)
Cline1.Layer = sLayer
Cline1.color = acGreen
Cline1.Linetype = "CENTER"
End Sub
-
Bryco First off thanks for your help. I put in the new sub and added the translations. When i run it now after i pick my points i get an execution error. I did not include the code from your second post as I thought it was more of a recommndation of how it should be done, is this correct
-
Then use Find to find all the occurences of DrawCLines
and add either "Shade1" or "Shade2" where appropriate.
Dan I ran it and it seems ok
-
bryco i did do a find and added the same lines you did. one thing i was trying to do was rather than put shade1 for everything like shown below i was numbering them shade1 shade2 shade3 so i can identify which should belong to which assembly as i did with the other lines. i added shade1-9 to be added to the drawing but its not working. could you possible upload yours to the swamp so i can try it out to see if it's something i did?
If ThisDrawing.IsSingleShade Then
If ThisDrawing.IsCS Then ' center support single shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "SHADE1"
Translate(0) = CLP2(0)
Translate(1) = CLP2(1)
Translate(2) = CLP2(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "SHADE1"
Else ' end condition single shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP2(0)
Translate(4) = CLP2(1)
Translate(5) = CLP2(2)
DrawCLines Translate, "SHADE1"
End If
Else
If ThisDrawing.IsCS Then ' center support double shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "SHADE1"
Translate(0) = CLP2(0)
Translate(1) = CLP2(1)
Translate(2) = CLP2(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "SHADE1"
Translate(0) = CLP4(0)
Translate(1) = CLP4(1)
Translate(2) = CLP4(2)
Translate(3) = CLP6(0)
Translate(4) = CLP6(1)
Translate(5) = CLP6(2)
DrawCLines Translate, "SHADE1"
Translate(0) = CLP5(0)
Translate(1) = CLP5(1)
Translate(2) = CLP5(2)
Translate(3) = CLP6(0)
Translate(4) = CLP6(1)
Translate(5) = CLP6(2)
DrawCLines Translate, "SHADE1"
Else ' end condition double shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP2(0)
Translate(4) = CLP2(1)
Translate(5) = CLP2(2)
DrawCLines Translate, "SHADE1"
Translate(0) = CLP4(0)
Translate(1) = CLP4(1)
Translate(2) = CLP4(2)
Translate(3) = CLP5(0)
Translate(4) = CLP5(1)
Translate(5) = CLP5(2)
DrawCLines Translate, "SHADE1"
-
bryco disregard my error report it appears something happened to my test drawing that was causing the error. when i try it in a new drawing it works great so far. i will try to sort out what belongs on which layer now. while i'm doing that do you know what i could do about seperating the cyan lines which are created using the hatchtube subroutine i posted. can this be done just like we did the centerlines. This looks like the first instance the subroutine is being used so what do i put there and here to put it on shade1 or shade2 layer? thank you so much you've been a great help.
If T1 < (ThisDrawing.dblBoRUD / 2) Then
HatchTube zZ1, zZ2, T1, (MainAngle - (Pi / 2))
Else
HatchTube zZ1, zZ2, (ThisDrawing.dblBoRUD / 2), (MainAngle - (Pi / 2))
End If
If T1 >= ThisDrawing.dblBoRUD Then
HatchTube zZ4, zZ5, (ThisDrawing.dblBoRUD / 2), (MainAngle + (Pi / 2))
End If
If T1 < (ThisDrawing.dblBoRUD / 2) Then
HatchTube Z1, Z2, T1, (MainAngle - (Pi / 2))
Else
HatchTube Z1, Z2, (ThisDrawing.dblBoRUD / 2), (MainAngle - (Pi / 2))
End If
If T1 >= ThisDrawing.dblBoRUD Then
HatchTube Z4, Z5, (ThisDrawing.dblBoRUD / 2), (MainAngle + (Pi / 2))
End If
If T2 < (ThisDrawing.dblSunRUD / 2) Then
HatchTube zZ6, zZ7, T2, (MainAngle - (Pi / 2))
Else
HatchTube zZ6, zZ7, (ThisDrawing.dblSunRUD / 2), (MainAngle - (Pi / 2))
End If
If T2 >= ThisDrawing.dblSunRUD Then
HatchTube zZ9, zZ10, (ThisDrawing.dblSunRUD / 2), (MainAngle + (Pi / 2))
End If
If T2 < (ThisDrawing.dblSunRUD / 2) Then
HatchTube Z6, Z7, T2, (MainAngle - (Pi / 2))
Else
HatchTube Z6, Z7, (ThisDrawing.dblSunRUD / 2), (MainAngle - (Pi / 2))
End If
If T2 >= ThisDrawing.dblSunRUD Then
HatchTube Z9, Z10, (ThisDrawing.dblSunRUD / 2), (MainAngle + (Pi / 2))
End If
-
can i apply the same logic by saying T1.Layer = "SHADE1" as shown below then specify a string in the hatchtube sub
If T1 < (ThisDrawing.dblBoRUD / 2) Then
HatchTube zZ1, zZ2, T1, (MainAngle - (Pi / 2))
Else
HatchTube zZ1, zZ2, (ThisDrawing.dblBoRUD / 2), (MainAngle - (Pi / 2))
T1.Layer = "SHADE1"
End If
If T1 >= ThisDrawing.dblBoRUD Then
HatchTube zZ4, zZ5, (ThisDrawing.dblBoRUD / 2), (MainAngle + (Pi / 2))
T1.Layer = "SHADE1"
End If
-
hmmm apparently not im stumped on how to acheive the rest
-
T1 is a double so it cannot be given a layer.
Yes you could change the Hatchtube to also accept a layer argument.
I've looked at the code and it's so all over the shop I think it should be rewritten
-
unfortunately i don't have the time or knowledge to rewrite the code at this point. Like i said i would eventually like to add grouping to it, insertion of brackets, and notes but not right now. Thanks for your help