abraxus Posted September 26, 2013 Share Posted September 26, 2013 What would be the best way to get a bounding box for a selection set in VBA? Google found a LISP routine that can do it, but it has been years since I have used LISP I was thinking someone here might be easily able to convert this small LISP routine to VBA for me (defun LM:SSBoundingBox ( ss / i l1 l2 ll ur ) (repeat (setq i (sslength ss)) (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur) (setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2) ) ) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2)) ) Quote Link to comment Share on other sites More sharing options...
abraxus Posted September 26, 2013 Author Share Posted September 26, 2013 i guess now that i think about it - it's probably not all that hard to just iterate thru each item in the selection set and track the min and max x and y coords... i guess i was just thinking that autocad would have this built in... guess not Quote Link to comment Share on other sites More sharing options...
abraxus Posted September 27, 2013 Author Share Posted September 27, 2013 ok, so yeah, i feel like an idiot for even asking this question now here's the solution for those of you who wondered Public Sub GetSSBoundingBox(ss As AcadSelectionSet, ptMin As Variant, ptMax As Variant) Dim entItem As AcadEntity Dim ptImin As Variant Dim ptImax As Variant Const X = 0 Const Y = 1 ss(0).GetBoundingBox ptMin, ptMax For Each entItem In ss entItem.GetBoundingBox ptImin, ptImax If ptImin(X) < ptMin(X) Then ptMin(X) = ptImin(X) If ptImin(Y) < ptMin(Y) Then ptMin(Y) = ptImin(Y) If ptImax(X) > ptMax(X) Then ptMax(X) = ptImax(X) If ptImax(Y) > ptMax(Y) Then ptMax(Y) = ptImax(Y) Next End Sub and here is how to call the function Public Sub FlipTest() Dim ssFlip As AcadSelectionSet Dim pt1 As Variant Dim pt2 As Variant ' get selection set from user Set ssFlip = ThisDrawing.SelectionSets.Add("flip") ssFlip.SelectOnScreen ' get bounding box of selection set GetSSBoundingBox ssFlip, pt1, pt2 ' draw a line from point to point ThisDrawing.ModelSpace.AddLine pt1, pt2 ssFlip.Delete End Sub Quote Link to comment Share on other sites More sharing options...
selvamani Posted August 31, 2017 Share Posted August 31, 2017 your code is awesome is there any way to pass this pt1 & pt2 to plot (window) for printing Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 1, 2017 Share Posted September 1, 2017 (edited) selvamani the code does this look at ptimin ptimax . You can pass these to a plot window sub and say use Fit. There is lots of plot code here mainly lisp but I am sure you can find a VBA version, if thats what you want. https://forums.autodesk.com/t5/autocad-forum/plotting-in-a-vba-script/td-p/3249378 abraxus a check for which space your in may be a good idea. Tested in a layout and drew a line in model space. Nice code though can see lots of use like plotting. Edited September 1, 2017 by BIGAL Quote Link to comment Share on other sites More sharing options...
selvamani Posted September 2, 2017 Share Posted September 2, 2017 thanks BIGAL i need to find specific block which is used multiple times in a cad and and change its attributes values one by one through vba any help on this please Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 3, 2017 Share Posted September 3, 2017 selvamani do a search here for attribute & vba lots of posted examples. Quote Link to comment Share on other sites More sharing options...
selvamani Posted September 6, 2017 Share Posted September 6, 2017 this points iam getting from bounding box in main sub i dont know what is happenning i got only empty window as layout but actually points given to setplotwindow is not empty plese help on this code for your reference Sub Example_SetWindowToPlot(point1 As Variant, point2 As Variant) ' This example allows the user to define an area in the current layout ' and displays a plot preview of the defined area. ' ' * Note: You have to exit the ' plot preview before the VBA example will stop and control will be returned AppActivate ThisDrawing.Application.Caption ' Dim point1 As Variant, point2 As Variant ' Get first point in window 'point1 = ThisDrawing.Utility.GetPoint(, "Click the lower-left of the window to plot.") ReDim Preserve point1(0 To 1) ' Change this to a 2D array by removing the Z position ' Get second point in window 'point2 = ThisDrawing.Utility.GetPoint(, "Click the upper-right of the window to plot.") ReDim Preserve point2(0 To 1) ' Change this to a 2D array by removing the Z position ' Send information about window to current layout ThisDrawing.ActiveLayout.SetWindowToPlot point1, point2 ThisDrawing.Plot.DisplayPlotPreview acFullPreview ' Read back window information ThisDrawing.ActiveLayout.GetWindowToPlot point1, point2 MsgBox "Press any key to plot the following window:" & vbCrLf & vbCrLf & _ "Lower Left: " & point1(0) & ", " & point1(1) & vbCrLf & _ "Upper Right: " & point2(0) & ", " & point2(1) ' Be sure to plot a view, not some other plot style ThisDrawing.ActiveLayout.PlotType = acWindow ' Send Plot To Window ThisDrawing.ActiveLayout.ConfigName = "DWG to PDF.pc3" ThisDrawing.Plot.DisplayPlotPreview acFullPreview End Sub Quote Link to comment Share on other sites More sharing options...
cad&cnc Posted January 27, 2020 Share Posted January 27, 2020 How do you get the dimensions length and width of the bounding box. Also if the shape is rotated how could i make that work something like LM:minboundingbox. I'm working on a macro to get a shape max and min dimensions to export to exel file. thinking it would be easier in vba then Lisp Quote Link to comment Share on other sites More sharing options...
abraxus Posted January 27, 2020 Author Share Posted January 27, 2020 The length and width can be calculated by subtracting the minimum X/Y values from the maximum X/Y values. If it is rotated then you would need to rotate the objects back to a 0 rotation before getting the bounding box. You can do this with temporary objects you create by making a copy of them first, and then deleting them after the calculations have been made. The way a bounding box works is that it has to be based on 90 degree values from the WCS. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 29, 2020 Share Posted January 29, 2020 (edited) Try UCS OB then do bounding box. Checked a rectang same ht etc. Edited January 29, 2020 by BIGAL Quote Link to comment Share on other sites More sharing options...
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.