Results 1 to 7 of 7

Thread: Wipeout

  1. #1
    Active Member
    Join Date
    2011-10
    Location
    Norfolk England
    Posts
    57
    Login to Give a bone
    0

    Default Wipeout

    Hi

    Can anyone help with this vb macro - Pleeease

    The object is to create a block and add a wipeout
    As wipeout isn't supported as an object the only way, I can see, is to create the wipeout object in model space.

    The wipeout object can be added to model space - that's fine

    How do I place/copy this wipeout object into the block without invoking a user input, which is needed with 'getentity', and then delete the model space wipeout object.

    I've been scratching my head and only got a splinter.

    Thx in advance
    Geoff

    Code:
     Sub BasicVlv()
     
        Dim Pnts() As Double
        Dim CtrPnt(0 To 2) As Double
        Dim blockRefObj As AcadBlockReference
        Dim blockObj As AcadBlock
        Dim plineObj As AcadLWPolyline
        Dim WipeOutobj As AcadWipeout
        Dim StartPnt(0 To 2) As Double
        Dim EndPnt(0 To 2) As Double
        Dim blkName As String
      
    blkName = "BasicVlv"
    
        ' Define the block Insertion Point
        CtrPnt(0) = 0: CtrPnt(1) = 0: CtrPnt(2) = 0
        
        Set blockObj = ThisDrawing.Blocks.Add(CtrPnt, blkName)
     
     'construct basic valve shape around 0,0
    ReDim Pnts(0 To 9)
    Pnts(0) = -4: Pnts(1) = 2
    Pnts(2) = -4: Pnts(3) = -2
    Pnts(4) = 4: Pnts(5) = 2
    Pnts(6) = 4: Pnts(7) = -2
    
    
        ThisDrawing.SendCommand "wipeout" & vbCr & Pnts(0) & "," & Pnts(1) & vbCr & Pnts(2) & "," & Pnts(3) & vbCr & Pnts(4) & _
                                            "," & Pnts(5) & vbCr & Pnts(6) & "," & Pnts(7) & vbCr & vbCr
                                               
        'ThisDrawing.ModelSpace.AddLightWeightPolyline (Pnts)
    
            blockObj.AddLightWeightPolyline(Pnts)
           'blockobj.'Something!!!' for the wipeout
    
    
        'ThisDrawing.SendCommand "-insert" & vbCr & blkName & vbCr & "scale" & vbCr & "1" & vbCr
     
     End Sub
    Last edited by Ed Jobe; 2023-12-13 at 04:45 PM. Reason: Added code tags [CODE] [/CODE]

  2. #2
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,420
    Login to Give a bone
    0

    Default Re: Wipeout

    You could use SelectionSet.Select acSelectionSetLast to get the wipeout that was created. However, that may not capture the correct draworder to go behind the polyline. So, in this case, I would add all the block ents to modelspace at some point in the distance, off screen where you are sure that nothing will be there. Then do a SelectionSet.Select acSelectionSetWindow to recover all the block ents and add those to the block definition. Then erase the ents in the selectionset.

    If you use the ModelSpace (or PaperSpace) InsertBlock method, it will return an AcadBlockReference object that you can use later, for example.
    Code:
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    With blockRefObj
        .Layer = "Blocks"
        .Color = acByLayer
        .Update
    End With
    C:> ED WORKING....


    LinkedIn

  3. #3
    Active Member
    Join Date
    2011-10
    Location
    Norfolk England
    Posts
    57
    Login to Give a bone
    0

    Default Re: Wipeout

    Thx Ed

    I have added the wipeout as selection set to the block, if this done before the polyline is added to the block the desired draw order is acheived.
    However by erasing or deleting the selection set doesn't delete the model space entities.

    How is that acheived?

    New code ...........

    Code:
     Sub BasicVlv()
     
        Dim Pnts() As Double
        Dim CtrPnt(0 To 2) As Double
        Dim blockRefObj As AcadBlockReference
        Dim blockObj As AcadBlock
        Dim plineObj As AcadLWPolyline
        Dim WipeOutobj As AcadWipeout
        Dim StartPnt(0 To 2) As Double
        Dim EndPnt(0 To 2) As Double
        Dim blkName As String
        Dim SelSet As AcadSelectionSet
        Dim SelArray(0) As Object
      
    blkName = "BasicVlv"
    
        ' Define the block Insertion Point
        CtrPnt(0) = 0: CtrPnt(1) = 0: CtrPnt(2) = 0
        
        'create block definition
        Set blockObj = ThisDrawing.Blocks.Add(CtrPnt, blkName)
     
     'construct basic valve shape around 0,0
    ReDim Pnts(0 To 9)
    Pnts(0) = -4: Pnts(1) = 2
    Pnts(2) = -4: Pnts(3) = -2
    Pnts(4) = 4: Pnts(5) = 2
    Pnts(6) = 4: Pnts(7) = -2
    Pnts(8) = -4: Pnts(9) = 2
    
        ThisDrawing.SendCommand "wipeout" & vbCr & Pnts(0) & "," & Pnts(1) & vbCr & Pnts(2) & "," & Pnts(3) & vbCr & Pnts(4) & _
                                            "," & Pnts(5) & vbCr & Pnts(6) & "," & Pnts(7) & vbCr & vbCr
                                               
        Set SelSet = ThisDrawing.SelectionSets.Add("WipeOut")
    
        SelSet.Select acSelectionSetLast
        
        Set SelArray(0) = SelSet.Item(0)
        
        ThisDrawing.CopyObjects SelArray, blockObj
    
        Set plineObj = blockObj.AddLightWeightPolyline(Pnts)
           
            plineObj.color = acByLayer
            plineObj.Linetype = "continuous"
            plineObj.Lineweight = acLnWt030
            plineObj.Layer = 0
            
         'Remove Selection Set
         For Each SelSet In ThisDrawing.SelectionSets
              If SelSet.Name = "WipeOut" Then
                   SelSet.Delete
                   Exit For
              End If
         Next
                
        'ThisDrawing.SendCommand "-insert" & vbCr & blkName & vbCr & "scale" & vbCr & "1" & vbCr
    
     End Sub
    Last edited by Ed Jobe; 2023-12-14 at 03:37 PM. Reason: Added code tags [CODE] [/CODE]

  4. #4
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,420
    Login to Give a bone
    0

    Default Re: Wipeout

    First, when you post code, please use code tags. You can type them in manually, or click Go Advanced and use the # button.

    That's not what I had in mind. Follow these steps.
    1. add the wipeout to modelspace
    2. add the pline to modelspace (or as many objects as you need)
    3. create a ss and use select window to select the block ents
    4. add the ss contents to the block def
    5. use the ss erase method to delete the ents
    6. then delete the ss

    If I get time, I'll update your code. Don't use sendcommand to insert the block.
    C:> ED WORKING....


    LinkedIn

  5. #5
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,420
    Login to Give a bone
    0

    Default Re: Wipeout

    Here it is.
    Code:
    Sub BasicVlv()
     
        Dim i As Integer
        Dim Pnts() As Double
        Dim CtrPnt(0 To 2) As Double
        Dim Pnt1(0 To 2) As Double
        Dim Pnt2(0 To 2) As Double
        Dim insPnt(0 To 2) As Double
        Dim ent As AcadEntity
        Dim blockRefObj As AcadBlockReference
        Dim blockObj As AcadBlock
        Dim plineObj As AcadLWPolyline
        Dim WipeOutobj As AcadWipeout
        Dim StartPnt(0 To 2) As Double
        Dim EndPnt(0 To 2) As Double
        Dim blkName As String
        Dim SelSet As AcadSelectionSet
        Dim SelArray() As Object
        Dim clr As AcadAcCmColor
        Dim ip As Variant
        
        Set clr = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor." & Left(AcadApplication.Version, 2))
        clr.ColorIndex = acByLayer
        
        blkName = "BasicVlv"
    
        ' Define the block Insertion Point
        CtrPnt(0) = 0: CtrPnt(1) = 0: CtrPnt(2) = 0
        
        'create block definition
        Set blockObj = ThisDrawing.Blocks.Add(CtrPnt, blkName)
        
        'construct basic valve shape around 0,0
        ReDim Pnts(0 To 9)
        Pnts(0) = -4: Pnts(1) = 2
        Pnts(2) = -4: Pnts(3) = -2
        Pnts(4) = 4: Pnts(5) = 2
        Pnts(6) = 4: Pnts(7) = -2
        Pnts(8) = -4: Pnts(9) = 2
        
        'since the WIPEOUT command adds it to the active space, make sure ms is active
        ThisDrawing.ActiveSpace = acModelSpace
        
        ThisDrawing.SendCommand "wipeout" & vbCr & Pnts(0) & "," & Pnts(1) & vbCr & Pnts(2) & "," & Pnts(3) & vbCr & Pnts(4) & _
                                            "," & Pnts(5) & vbCr & Pnts(6) & "," & Pnts(7) & vbCr & vbCr
                                               
        Set SelSet = AddSelectionSet("VlvBlock")
    
        SelSet.Select acSelectionSetLast
        Set WipeOutobj = SelSet.Item(0)
        With WipeOutobj
            .Layer = "0"
            .TrueColor = clr
            .Update
        End With
     
        
        Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Pnts)
        With plineObj
            .TrueColor = clr
            .Linetype = "Continuous"
            .Lineweight = acLnWt030
            .Layer = "0"
            '.Closed = True
            .Update
        End With
        
        'points for selectionset window
        Pnt1(0) = -5: Pnt1(1) = -3: Pnt1(2) = 0
        Pnt2(0) = 5: Pnt2(1) = 3: Pnt2(2) = 0
        
        SelSet.Clear
        SelSet.Select acSelectionSetWindow, Pnt1, Pnt2
        ReDim SelArray(0 To SelSet.Count - 1)
        For Each ent In SelSet
            Set SelArray(i) = SelSet.Item(i)
            i = i + 1
        Next ent
        
        ThisDrawing.CopyObjects SelArray, blockObj
        
        SelSet.Erase
        SelSet.Delete
        
        'insert method, no input
        'ThisDrawing.ModelSpace.InsertBlock insPnt, blkName, 1, 1, 1, 0
        
        'insert method, user input
        ip = ThisDrawing.Utility.GetPoint(, "Select an insertion point for the valve:")
            
        ThisDrawing.ModelSpace.InsertBlock ip, blkName, 1, 1, 1, 0
    
     End Sub
    C:> ED WORKING....


    LinkedIn

  6. #6
    Active Member
    Join Date
    2011-10
    Location
    Norfolk England
    Posts
    57
    Login to Give a bone
    0

    Default Re: Wipeout

    Thx Ed for being so prompt

    I have incorporated your changes and works a treat

    Couple of things
    1. The reason I use the 'sendcommand' to place the block is - the block gets placed on the cursor so the user can place and rotate it as required.
    What are the reasons you are against it?
    2. The use of the 'truecolour' method of setting the colour of the object. (if I wanted to have a different colour, say red, how would this be acheived)
    I would have used 'object.colour = acRed'

    Perhaps not the place for these questions, not sure where else to go
    There's still a lot I don't know, but I'm getting by.

    Best Regards
    Geoff

  7. #7
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,420
    Login to Give a bone
    0

    Default Re: Wipeout

    Quote Originally Posted by Calteq View Post
    1. The reason I use the 'sendcommand' to place the block is - the block gets placed on the cursor so the user can place and rotate it as required.
    What are the reasons you are against it?
    If you use SendCommand, you have the same problem as with the wipeout, you can't instantiate an object variable. The InsertBlock method returns an AcadBlockReference object. You can still have user input. I only used the GetPoint method, but you could prompt for other values, such as rotation angle and scale.

    Quote Originally Posted by Calteq View Post
    2. The use of the 'truecolour' method of setting the colour of the object. (if I wanted to have a different colour, say red, how would this be acheived)
    I would have used 'object.colour = acRed'
    Entities no longer have a Color property. That was depricated a few years ago. The TrueColor object has the ColorIndex method. In this example, I used the acByLayer constant, but you could use acRed or an integer from 0-255.
    C:> ED WORKING....


    LinkedIn

Similar Threads

  1. Wipeout does not wipeout on one particular device
    By sturner in forum AutoCAD Plotting
    Replies: 6
    Last Post: 2007-04-23, 04:49 PM
  2. Civil 3D 2007 - Wipeout does not wipeout Objects in a floating viewport
    By youngrl501483 in forum AutoCAD Civil 3D - General
    Replies: 10
    Last Post: 2007-03-14, 09:47 PM
  3. Wipeout printing problem
    By stephan.villeneuve in forum AutoCAD Plotting
    Replies: 4
    Last Post: 2004-06-15, 08:39 PM
  4. Express Wipeout
    By dfefield69574 in forum AutoCAD General
    Replies: 2
    Last Post: 2004-06-10, 08:31 PM
  5. More Wipeout
    By nhugley in forum AutoCAD Wish List
    Replies: 1
    Last Post: 2004-06-04, 08:28 PM

Posting Permissions

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