Drawing a rectangle with VBA?
Well, this would seem to be a simpl task, but I've been pounding my head with this for over a day now. How to draw a rectangle!I've copied some examples from the Autodesk forum, but am having problems. here is an example. I have two separate routines, the first will draw a rectangle with dimensions. But, when I try to convert it to routine to only draw a simple rectangle, it doesn't work. It doesn't generate an error either.Here are both routines, which are written as functions;Public Function DrawDimensionedRectangle(InsertionPoint As Variant, Width As Double, Height As Double) As AcadLWPolyline'Draws a Rectangle, and adds dimensions.Dim VerticesList(0 To 9) As DoubleDim ExtLine1(0 To 2) As DoubleDim ExtLine2(0 To 2) As DoubleDim TextPosition(0 To 2) As Double'create a polyline counterclockwiseVerticesList(0) = InsertionPoint(0): VerticesList(1) = InsertionPoint(1)VerticesList(2) = InsertionPoint(0): VerticesList(3) = InsertionPoint(1) + HeightVerticesList(4) = InsertionPoint(0) + Width: VerticesList(5) = InsertionPoint(1) + HeightVerticesList(6) = InsertionPoint(0) + Width: VerticesList(7) = InsertionPoint(1)VerticesList(8) = InsertionPoint(0): VerticesList(9) = InsertionPoint(1) 'this closes the polylineWith ThisDrawing Set DrawDimensionedRectangle = .ModelSpace.AddLightWeightPolyline(VerticesList) 'add horizontal dimension ExtLine1(0) = VerticesList(2): ExtLine1(1) = VerticesList(3): ExtLine1(2) = 0 ExtLine2(0) = VerticesList(4): ExtLine2(1) = VerticesList(5): ExtLine2(2) = 0 TextPosition(0) = VerticesList(2) + (Width / 2): TextPosition(1) = VerticesList(3) + 30: TextPosition(2) = 0 .ModelSpace.AddDimAligned ExtLine1, ExtLine2, TextPosition 'add vertical dimension ExtLine1(0) = VerticesList(0): ExtLine1(1) = VerticesList(1): ExtLine1(2) = 0 ExtLine2(0) = VerticesList(2): ExtLine2(1) = VerticesList(3): ExtLine2(2) = 0 TextPosition(0) = VerticesList(0) - 30: TextPosition(1) = VerticesList(1) + (Height / 2): TextPosition(2) = 0 .ModelSpace.AddDimAligned ExtLine1, ExtLine2, TextPositionEnd With'VVVVV This code is Remmed out VVVV'With Rectangle' 'close the rectangle' .Closed = True' 'make it appear on screen' .Update'End With'^^^^Remmed Out code^^^^^End FunctionPublic Function Rectangle(InsertionPoint As Variant, Width As Double, Height As Double) As AcadLWPolyline'Draws a polyline rectangleDim VerticesList(0 To 9) As Double'create a polyline counterclockwiseVerticesList(0) = InsertionPoint(0): VerticesList(1) = InsertionPoint(1)VerticesList(2) = InsertionPoint(0): VerticesList(3) = InsertionPoint(1) + HeightVerticesList(4) = InsertionPoint(0) + Width: VerticesList(5) = InsertionPoint(1) + HeightVerticesList(6) = InsertionPoint(0) + Width: VerticesList(7) = InsertionPoint(1)VerticesList(8) = InsertionPoint(0): VerticesList(9) = InsertionPoint(1) 'this closes the polyline'since this code below is having problems, I just 'close the pline with the last point above'VVVVV This code is Remmed out VVVV'With Rectangle' 'close the rectangle' .Closed = True' 'make it appear on screen' .Update'End With'^^^^Remmed Out code^^^^^End Function
Comments
-
What routine calls this function and passes the insertionpoint, width and height?That sub should probally have some getpoint, getreal etc that can then be passed to the function.Just a thought, might put a few Msgbox calls reporting the values so you can watch the var's or set some break points to single step through the function. Good luck.Jerry
0 -
Dear Joe,You forgot to actualy create the polyline.Hope this helps you.HuibSub test_rectangle()Dim insertionpoint(1) As VariantDim MyWidth As DoubleDim MyHeight As DoubleDim MyRectangle As AcadLWPolylineinsertionpoint(0) = 10insertionpoint(1) = 20MyHeight = 30MyWidth = 60Set MyRectangle = Rectangle(insertionpoint, MyWidth, MyHeight)MyRectangle.UpdateMyRectangle.Closed = TrueEnd SubPublic Function Rectangle(insertionpoint As Variant, Width As Double, Height As Double) As AcadLWPolyline'Draws a polyline rectangleDim VerticesList(0 To 9) As Double'create a polyline counterclockwiseVerticesList(0) = insertionpoint(0): VerticesList(1) = insertionpoint(1)VerticesList(2) = insertionpoint(0): VerticesList(3) = insertionpoint(1) + HeightVerticesList(4) = insertionpoint(0) + Width: VerticesList(5) = insertionpoint(1) + HeightVerticesList(6) = insertionpoint(0) + Width: VerticesList(7) = insertionpoint(1)VerticesList(8) = insertionpoint(0): VerticesList(9) = insertionpoint(1) 'this closes the polylineSet Rectangle = ActiveDocument.ModelSpace.AddLightWeightPolyline(VerticesList)'since this code below is having problems, I just'close the pline with the last point above'VVVVV This code is Remmed out VVVV'With Rectangle' 'close the rectangle' .Closed = True' 'make it appear on screen' .Update'End With'^^^^Remmed Out code^^^^^End Function
0 -
Thank you Huib, you found my missing line. Set Rectangle = ActiveDocument.ModelSpace.AddLightWeightPolyline(VerticesList) I didn't actually forget it, rather I just didn't understand it. I've dabbled in VBA in the past, and taken a class in VBA for Access (the database). I guess my trouble is that I tend to think of VBA interfacing with BricsCad the same way that I interface with BricsCAD as a user. But, the object oriented program approach always gets me confused. Jerry, thanks for your reply as well. In my case, I am making a routine which will automatically draw a refigeration chamber based on input on a user form (no user clicking on the drawing screen is needed).I do try to track the code using break points. This is an imporant part of VBA, which is missing from Lisp, and so the reason I am using VBA. But, I think my mind is still thinking like Lisp.Joe Dunfee
0 -
Huib, I must be making some progress. I've made a correction your code!On your modification to my rotine, I see that the rectangle was not updating properly because the close command was occuring before the update command. Also, because my original routine was not closing the polyline at all, I had to add the final vertice to close it. In your routine, that extra point is not needed. Below is the fully functional routine for those interested.I do have one question. I normally prefer to put as much of the code as I can inside the function. Is it possible to put the close and update commands inside the function. I see that the MyRectangle is a variable which contains the rectangle. How would I refer to that same variable(the rectangle) in the function?Sub test_rectangle()Dim insertionpoint(1) As VariantDim MyWidth As DoubleDim MyHeight As DoubleDim MyRectangle As AcadLWPolylineinsertionpoint(0) = 10insertionpoint(1) = 20MyHeight = 30MyWidth = 60Set MyRectangle = Rectangle2(insertionpoint, MyWidth, MyHeight)MyRectangle.Closed = TrueMyRectangle.UpdateEnd Sub'---------------------------------------------------------------------Public Function Rectangle2(insertionpoint As Variant, Width As Double, Height As Double) As AcadLWPolyline'Draws a polyline rectangleDim VerticesList(0 To 7) As Double'create a polyline counterclockwiseVerticesList(0) = insertionpoint(0): VerticesList(1) = insertionpoint(1)VerticesList(2) = insertionpoint(0): VerticesList(3) = insertionpoint(1) + HeightVerticesList(4) = insertionpoint(0) + Width: VerticesList(5) = insertionpoint(1) + HeightVerticesList(6) = insertionpoint(0) + Width: VerticesList(7) = insertionpoint(1)Set Rectangle2 = ActiveDocument.ModelSpace.AddLightWeightPolyline(VerticesList)End Function
0 -
Haha... Yes Joe, it seems you are making progress indeed.I wrote the modifications to your code in about 5 minutes. So I'm not surpirsed it contained a mistake (or some sloppy programming)To answer your question of closing and updating in the function, as you can see, the rectangle is created with a SET command.You assign a newly created object to "Rectangle2"Therefore "Rectangle2" is an object with all the methods and properties of a polyline.You can close and update in the function like this:Sub test_rectangle()Dim insertionpoint(1) As VariantDim MyWidth As DoubleDim MyHeight As DoubleDim MyRectangle As AcadLWPolylineinsertionpoint(0) = 10insertionpoint(1) = 20MyHeight = 30MyWidth = 60Set MyRectangle = Rectangle2(insertionpoint, MyWidth, MyHeight)End Sub'---------------------------------------------------------------------Public Function Rectangle2(insertionpoint As Variant, Width As Double, Height As Double) As AcadLWPolyline'Draws a polyline rectangleDim VerticesList(0 To 7) As Double'create a polyline counterclockwiseVerticesList(0) = insertionpoint(0): VerticesList(1) = insertionpoint(1)VerticesList(2) = insertionpoint(0): VerticesList(3) = insertionpoint(1) + HeightVerticesList(4) = insertionpoint(0) + Width: VerticesList(5) = insertionpoint(1) + HeightVerticesList(6) = insertionpoint(0) + Width: VerticesList(7) = insertionpoint(1)Set Rectangle2 = ActiveDocument.ModelSpace.AddLightWeightPolyline(VerticesList)Rectangle2.Closed = TrueRectangle2.UpdateEnd Function
0 -
Oops, I see I had a mistake on my last post. All the Rectangle2 should have just been Rectangle.Joe Dunfee
0 -
What's in a name....It is your privalidge to call it Rectangle2 if you wish...
0