Author Topic: Explode Dims  (Read 7706 times)

0 Members and 1 Guest are viewing this topic.

Maverick®

  • Seagull
  • Posts: 14778
Re: Explode Dims
« Reply #15 on: June 07, 2007, 05:09:59 PM »
  That would be termed a "Hijack".  And I almost never do it.  :angel:

  Welcome BTW.  I hope someone who actually knows something will come along soon and help you out.  :-D

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Explode Dims
« Reply #16 on: June 07, 2007, 08:32:04 PM »
Dan the handle didn't always work.
Search this site for the function vbassoc then run below

Code: [Select]
Sub thesilenceofthedims()

    Dim D As AcadDimension
    Dim sBlock As String
    Dim Ent As AcadEntity
    Dim oBlock As AcadBlock
    Dim Ents() As AcadEntity
    Dim i As Integer, ct As Integer
   
    Set D = EntSel
    sBlock = vbAssoc(D, 2)
    Set oBlock = ThisDrawing.Blocks(sBlock)
   
    ct = oBlock.count - 1
    ReDim Ents(ct)
    For i = 0 To ct
        Set Ents(i) = oBlock(i)
    Next i
   
    ThisDrawing.CopyObjects Ents, ThisDrawing.ModelSpace
    D.Delete
    oBlock.Delete

End Sub

MickD

  • King Gator
  • Posts: 3619
  • (x-in)->[process]->(y-out) ... simples!
Re: Explode Dims
« Reply #17 on: June 07, 2007, 08:37:34 PM »
Why don't you just override the dim text from '<>' to the 'measurement' value or whatever you want, I'm assuming you want to 'shrink' a detail to fit on a page say, if not, never mind :)
"Short cuts make long delays,' argued Pippin.”
J.R.R. Tolkien

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Explode Dims
« Reply #18 on: June 07, 2007, 08:38:07 PM »
...
Code: [Select]
Sub thesilenceofthedims()
'' .............
End Sub
:lol:
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Dan

  • Guest
Re: Explode Dims
« Reply #19 on: June 08, 2007, 02:44:46 PM »
Dan the handle didn't always work.
Search this site for the function vbassoc then run below



"thesilenceofthedims" - NiCE....
Thank you, I am doing some testing now, and believe that I just need to change the following line in the function vbassoc code to work with 2007 & 2008.
Code: [Select]
If Left(ThisDrawing.Application.Version, 2) = "16" Or Left(ThisDrawing.Application.Version, 2) = "17" Then


So far, so good.  This is a new approach that I am unfamiliar with. Thank you for helping me to learn something new.  If I am overlooking something Please let me know.

Code: [Select]
Sub ExplodeDim()

Dim sstext As AcadSelectionSet
Dim blk As AcadBlockReference
Dim oEnt As AcadEntity
Dim FilterType(1) As Integer
Dim FilterData(1) As Variant


    On Error Resume Next
    ThisDrawing.SelectionSets.Item("XDim").Delete
    Set sstext = ThisDrawing.SelectionSets.Add("XDim")

    FilterType(0) = 67
    FilterData(0) = 0
    FilterType(1) = 0
    FilterData(1) = "Dimension"

    sstext.Select acSelectionSetAll, , , FilterType, FilterData
   
    For Each oEnt In sstext
        If TypeOf oEnt Is AcadDimAligned Then
            If oEnt.TextColor = 5 And oEnt.TextOverride <> " " And oEnt.TextOverride <> "" Then
                thesilenceofthedims oEnt
            End If
        End If
    Next

End Sub



'SomeCallMeDave
'http://www.vbdesign.net/expresso/showthread.php?postid=83887#post83887
'Changed pAcadObj As AcadObject to pAcadObj As Object to access imagedef as well
'Modified by Jeff Mishler, March 2006, to get the Block table object, not Block_Record table object
Public Function vbAssoc(pAcadObj, pDXFCode As Integer) As Variant

Dim VLisp As Object
Dim VLispFunc As Object
Dim varRetVal As Variant

Dim obj1 As Object
Dim obj2 As Object

Dim strHnd As String
Dim strVer As String

Dim lngCount As Long
Dim i As Long
Dim j As Long

On Error GoTo vbAssocError
If Left(ThisDrawing.Application.Version, 2) = "16" Or Left(ThisDrawing.Application.Version, 2) = "17" Then
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
Else
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
End If

Set VLispFunc = VLisp.ActiveDocument.Functions

If Not TypeOf pAcadObj Is AcadBlock Then
    strHnd = pAcadObj.Handle
Else
    Dim lispStr As String
    lispStr = "(cdr (assoc 5 (entget (tblobjname " & Chr(34) & "Block" & Chr(34) & Chr(34) & pAcadObj.Name & Chr(34) & "))))"
    Set obj1 = VLispFunc.Item("read").Funcall(lispStr)
    strHnd = VLispFunc.Item("eval").Funcall(obj1)
End If
Set obj1 = VLispFunc.Item("read").Funcall("pDXF")
  varRetVal = VLispFunc.Item("set").Funcall(obj1, pDXFCode)
Set obj1 = VLispFunc.Item("read").Funcall("pHandle")
  varRetVal = VLispFunc.Item("set").Funcall(obj1, strHnd)
Set obj1 = VLispFunc.Item("read").Funcall("(vl-princ-to-string (cdr (assoc pDXF (entget (handent pHandle)))))")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)

vbAssoc = varRetVal

'clean up the newly created LISP symbols
Set obj1 = VLispFunc.Item("read").Funcall("(setq pDXF nil)")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)
Set obj1 = VLispFunc.Item("read").Funcall("(setq pHandle nil)")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)

'release the objects or Autocad gets squirrely (no offense RR)
Set obj2 = Nothing
Set obj1 = Nothing
Set VLispFunc = Nothing
Set VLisp = Nothing

Exit Function

vbAssocError:
  Set obj2 = Nothing
  Set obj1 = Nothing
  Set VLispFunc = Nothing
  Set VLisp = Nothing
  MsgBox "Error occurred " & Err.Description

End Function



Sub thesilenceofthedims(EntSel As AcadDimension)

    Dim D As AcadDimension
    Dim sBlock As String
    Dim Ent As AcadEntity
    Dim oBlock As AcadBlock
    Dim Ents() As AcadEntity
    Dim i As Integer, ct As Integer
   
    Set D = EntSel
    sBlock = vbAssoc(D, 2)
    Set oBlock = ThisDrawing.Blocks(sBlock)
   
    ct = oBlock.Count - 1
    ReDim Ents(ct)
    For i = 0 To ct
        Set Ents(i) = oBlock(i)
    Next i
   
    ThisDrawing.CopyObjects Ents, ThisDrawing.ModelSpace
    D.Delete
    oBlock.Delete

End Sub


Thanks again,
Dan

Guest

  • Guest
Re: Explode Dims
« Reply #20 on: June 08, 2007, 02:45:54 PM »
Just a thought.... Could you use QSELECT and select the dims, then explode, and thus eliminate the need for the coding??!?

Dan

  • Guest
Re: Explode Dims
« Reply #21 on: June 08, 2007, 03:58:14 PM »
Just a thought.... Could you use QSELECT and select the dims, then explode, and thus eliminate the need for the coding??!?

Exploding specific DIMS is part of a large automation that will be ran on 100's of dwgs.  A user will not be interacting with the dwgs at this stage.

Guest

  • Guest
Re: Explode Dims
« Reply #22 on: June 08, 2007, 04:11:20 PM »
Just a thought.... Could you use QSELECT and select the dims, then explode, and thus eliminate the need for the coding??!?

Exploding specific DIMS is part of a large automation that will be ran on 100's of dwgs.  A user will not be interacting with the dwgs at this stage.
Gotcha!