+ Reply to Thread
Results 1 to 8 of 8
  1. #1
    Full Member abraxus's Avatar
    Using
    AutoCAD 2012
    Join Date
    Aug 2013
    Posts
    68

    Default Bounding Box for Selection Set

    Registered forum members do not see this ad.

    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

    Code:
    (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))
    )

  2. #2
    Full Member abraxus's Avatar
    Using
    AutoCAD 2012
    Join Date
    Aug 2013
    Posts
    68

    Default

    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

  3. #3
    Full Member abraxus's Avatar
    Using
    AutoCAD 2012
    Join Date
    Aug 2013
    Posts
    68

    Default

    ok, so yeah, i feel like an idiot for even asking this question now

    here's the solution for those of you who wondered

    Code:
    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

    Code:
    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

  4. #4
    Forum Newbie
    Discipline
    Electrical
    Using
    AutoCAD 2014
    Join Date
    Aug 2017
    Posts
    5

    Smile plotting issue

    your code is awesome
    is there any way to pass this pt1 & pt2 to plot (window) for printing

  5. #5
    Luminous Being
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    9,819

    Default

    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/autoc...t/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.
    Last edited by BIGAL; 1st Sep 2017 at 02:17 am.
    A man who never made mistakes never made anything

  6. #6
    Forum Newbie
    Discipline
    Electrical
    Using
    AutoCAD 2014
    Join Date
    Aug 2017
    Posts
    5

    Default

    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

  7. #7
    Luminous Being
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    9,819

    Default

    selvamani do a search here for attribute & vba lots of posted examples.
    A man who never made mistakes never made anything

  8. #8
    Forum Newbie
    Discipline
    Electrical
    Using
    AutoCAD 2014
    Join Date
    Aug 2017
    Posts
    5

    Default setwindow plot issue

    Registered forum members do not see this ad.

    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

Similar Threads

  1. Bounding box for all objects?
    By bsamc2000 in forum AutoLISP, Visual LISP & DCL
    Replies: 13
    Last Post: 7th Feb 2017, 10:40 pm
  2. Bounding Box LISP
    By nicolas in forum AutoLISP, Visual LISP & DCL
    Replies: 3
    Last Post: 4th Nov 2010, 04:40 pm
  3. MTEXT--width of the bounding box
    By mattcai in forum AutoCAD Beginners' Area
    Replies: 3
    Last Post: 4th Nov 2009, 06:19 pm
  4. xRef Bounding Box
    By andybone in forum AutoCAD Drawing Management & Output
    Replies: 0
    Last Post: 6th Apr 2009, 03:50 pm
  5. Removing Bounding Box From Image
    By Keith1211 in forum AutoCAD Beginners' Area
    Replies: 8
    Last Post: 30th Jan 2006, 09:15 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts