Computer Aided Design

You are not logged in. [ Login ] Why log in
(NOTE: Login is not required to post)

Automataic dim setup

10/22/13       
steve ayars Member

ok so for years I have been doing my dimensions kinda wrong, and looking for help on how to correct it. The company likes us to use ft./in and in. all in the same line normally I would just use text overide in the properties menu. so we would type in 24'-0"\P( ) the trouble comes when we change something and forget to change the 24'-0" to the proper ft./in. and I'm wondering if there is a way that autocad can do it without the human error part. not sure how lisp work but want to learn, so if anyone has an ideas please
let me know. Thank you


View higher quality, full size image (898 X 640)

10/22/13       #2: Automataic dim setup ...
Alex

You should check out alternate dimensions.
Set primary units to architectural, and alternate to fractional.

IMO, you should use one or the other, not both..... but I understand how companies operate. Seems like shop guys dont want to think, but I could be wrong. I often am.

10/22/13       #3: Automataic dim setup ...
David Wishengrad

hahah Alex. The next thing they will want is a picture of someone using a hammer to explain the correct direction to hit a nail.

10/22/13       #4: Automataic dim setup ...
steve ayars Member

WHY DO YOU HAVE ONE

10/22/13       #5: Automataic dim setup ...
Alex

Glad to see you are still around Dave. :o)

"the more you give, the more they want... "
...and then they still wonder why it takes so long. Sometimes you just cant win for loosing.

10/22/13       #6: Automataic dim setup ...
David Wishengrad

Well, I have half of it.


View higher quality, full size image (720 X 936)

10/23/13       #7: Automataic dim setup ...
steve ayars Member

ha ha , thanks needed that.. but back to the question, some what self taught with autocad doing it for 8 years and never really messed with the alternate units. so I did what alex wrote but used decimal units but I'm getting a 3/4 before and 7/8 after the alternate dim. any ideas on why and what setting i might need to change. thank you for any help


View higher quality, full size image (640 X 702)

10/23/13       #8: Automataic dim setup ...
Alex

Set your alternate units to fractional (if you want that as opposed to decimal).
There typically are brackets around the alternate units. My guess is the font you are using is 'substituting' those brackets with fractions. Try using a more generic font and see if that helps. Sometimes those "cool" looking fonts can cause problems.

10/23/13       #9: Automataic dim setup ...
Alex

Google gave this quick tip that may work for you. You'll have to experiment with it.

AutoCAD tip

10/23/13       #10: Automataic dim setup ...
steve ayars Member

Thank you again Alex, I used the decimal because of the company standards. but will check out that link.

10/24/13       #11: Automataic dim setup ...
steve ayars Member

thank you Alex for the link that really helped but was wondering if you know what programing language autocad uses (c++ or vb) or something else and if anyone knows were I should look for info. on the key strokes and what they mean and how to use them (\P \X \F ect.)
thank you again

10/25/13       #12: Automataic dim setup ...
Alex

I think those are just Unicode or ASCII codes to modify the dimension text output. I have no idea how anyone would ever know that, or where that info is. I just googled and got lucky. I'm sure Dave would know better than me.

Autocad can use several programming languages, the most popular is AutoLISP, but C+, C# and flavors of .net, and others are common.
Hands down, the best place to learn programming for autocad is TheSwamp.org. CadTutor.net is a close second.

TheSwamp

10/25/13       #13: Automataic dim setup ...
David Wishengrad

No Alex,

I was following your lead here. I didn't even remember those existed and found your explanation of alternate dims. excellent. I learned something I just may use sometime. Thanks for the great information.

10/30/13       #14: Automataic dim setup ...
LJ

Where I once worked, each part drawing had three different dimension formats with each format on a different layer. The part had its own layer. The three different formats and layers were SHOP, ENG, and SALES. On the SHOP layer were all of the dimensions necessary to manufacture the part. The dimensions were decimal to three places and a medium text height. The dimensions on the ENG layer were to four places and a little smaller text height. This layer could have drawing details and dimensions not included on the SHOP layer. The dimensions on the Sales layer were fractional and a fairly large text height. The Sales layer had only what drawing details and dimensions that the customer would need.

I wrote three Lisp functions to control all of this and placed them in the Acad.lsp file so that they were always available as command line commands. When one typed shop at the command line the SHOP layer was thawed and set current, the ENG and SALES layers frozen and the dimension format set to the SHOP format. The commands eng and sales worked the same way. If I wanted to look at, print or edit a sales drawing all I had to do was open the part drawing, type sales, and I was all set.

When a part drawing was being created I would do one format first, for example SHOP. I would then copy all of the dimensions on top of themselves. Next I would do a change property, previous, layer, eng. I would then type eng and do a dimension update on all of the dimensions and then add or delete dimensions as needed. I would then repeat the process for SALES.

10/30/13       #15: Automataic dim setup ...
David Wishengrad

This is some old code from vb6. It will automatically clear the grouping in autocad, create a new set of grouped objects based on their attacked xdata, export each assembly to their own drawing file, reopen each exported assembly of solids in their respective drawings, create a paperspace layout, insert a title block, fill out the title block with the necessary info, create a viewport of the assembly, and automatically dimension the assembly in modelspace on top of the paperspace viewport, print the page to a *.plt file, and after finished with all of the assemblies pop up a window to review each and every auto-generated and dimensioned drawing for the user to confirm everything is correct or add additional dims or notes. Some variables are public or globally defined, so you will have to create those so there are available for storage by their type.

Public Sub WallLayoutc(AcadApp As AcadApplication)

'WallLayoutc(AcadApp As AcadApplication)

WallLayout.Show vbModal

Set AutoCAD_Application = AcadApp
Set AcadApp2 = AcadApp
Set AutoCAD_Application = AcadApp2
On Error Resume Next

Set thisdrawing = AutoCAD_Application.ActiveDocument

Dim ssetObj As AcadSelectionSet
Dim Ent As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim intIndex As Integer
Dim objGrp As AcadGroup
Dim MyGroupData As String
Dim objEnts() As AcadEntity
Dim Ent2 As AcadEntity
Dim Groups As AcadGroups
Dim Grp As AcadGroup
Dim GrpEnt As AcadObject
'Dim grpName As String
Dim objEnts2(0 To 0) As AcadEntity
Dim EB1Name As String
Dim EB2Name As String
Dim TempPartName As String
Dim MyWSolid As Acad3DSolid
Dim BeenHere As Integer
Dim BeenHere2 As Integer
Dim EntCounter As Integer
Dim MyFileName As String
Dim SolidCentriod(0 To 2) As Double
Dim activeDoc As AcadDocument
Dim plotFileName As String
Dim EPSplotFileName As String
Dim result As Boolean
Dim result2 As Boolean
Dim objLayout As AcadLayout

'Dim JobName As String
'JobName = WallLayout.Text1.Text
PlotTypeCounter = -1

On Error Resume Next
thisdrawing.SelectionSets("prev").Delete
Set objSelSet = thisdrawing.SelectionSets.Add("prev")
objSelSet.Select acSelectionSetPrevious
On Error GoTo 0

ReDim entityarray(0) As AcadEntity
On Error Resume Next
thisdrawing.SelectionSets("EXPORTSET").Delete
Set exportObjSet = thisdrawing.SelectionSets.Add("EXPORTSET")
On Error GoTo 0

DocHoldName = thisdrawing.Name
Set Groups = thisdrawing.Groups

'clean out the folder
If Len(Dir("C:\SL-DWG\*.*")) > 0 Then

Kill "C:\SL-DWG\*.*"
End If

'explode all groups and make a new one on eb1
For Each Grp In Groups

grpName = Grp.Name

If GroupExists(grpName) Then

thisdrawing.Groups.Item(grpName).Delete

End If
Next

Dim GroupArray() As String
Dim GroupArrayCounter As Integer
GroupArrayCounter = -1
Dim YY As Integer

Dim MySelectionSet As AcadSelectionSet

'all exploded
'i need to get the groups of only the selected parts
'so make a list of only need groups and pass that in
If WallUserSelectable = 4 Then

For Each Ent In objSelSet

MyGroupData = UCase(getXdataInformation2(Ent.Handle, "EB1", thisdrawing))

'create a list of all groups in the selectionset as an array

If MyGroupData "" Then

GroupArrayCounter = GroupArrayCounter + 1

ReDim Preserve GroupArray(GroupArrayCounter)

GroupArray(GroupArrayCounter) = MyGroupData

'Set objGrp = thisdrawing.Groups.Add(MyGroupData)

'Set objEnts2(0) = Ent

'objGrp.AppendItems objEnts2

End If

Next

On Error Resume Next

For Each Ent In thisdrawing.ModelSpace

MyGroupData = UCase(getXdataInformation2(Ent.Handle, "EB1", thisdrawing))

For YY = 0 To UBound(GroupArray)

If MyGroupData "" Then

If GroupArray(YY) = MyGroupData Then

Set objGrp = thisdrawing.Groups.Add(MyGroupData)

Set objEnts2(0) = Ent

objGrp.AppendItems objEnts2

End If

End If

Next

Next

GoTo SkipOverAuto
End If

'this auto code makes groups based on everything in the drawing
For Each Ent In thisdrawing.ModelSpace

MyGroupData = UCase(getXdataInformation2(Ent.Handle, "EB1", thisdrawing))

If MyGroupData "" Then

Set objGrp = thisdrawing.Groups.Add(MyGroupData)

Set objEnts2(0) = Ent

objGrp.AppendItems objEnts2

End If
Next

SkipOverAuto:
On Error GoTo 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'new code for making a block
'Create a new block called "New_Block"
Dim blockObj As AcadBlock
Dim blkName2 As String
Dim insertionPnt(0 To 2) As Double
Dim MyItemCounter As Integer
Dim blkRef As AcadBlockReference
Dim insPtx(0 To 2) As Double
insertionPnt(0) = 0
insertionPnt(1) = 0
insertionPnt(2) = 0
insPtx(0) = 0
insPtx(1) = 0
insPtx(2) = 0

For Each Grp In Groups

'make sure the exportObjSet is cleared each time

On Error Resume Next

thisdrawing.SelectionSets("EXPORTSET").Delete

On Error GoTo 0

Set exportObjSet = thisdrawing.SelectionSets.Add("EXPORTSET")

exportObjSet.Clear

'cre
ate a selection set of solids in the group

grpName = Grp.Name

ExportCounter = -1

For Each Ent In Grp

ExportCounter = ExportCounter + 1

ReDim Preserve entityarray(ExportCounter) As AcadEntity

Set entityarray(ExportCounter) = Ent

Next

'add entities to the exportObjSet selectionset

exportObjSet.AddItems entityarray

' 'clear out the ref and the block if they exist
' If BlockExists("New_Block") Then
' blkRef.Delete
' blockObj.Delete
' End If

'add the block to the blocks collection

Set blockObj = thisdrawing.Blocks.Add(insertionPnt, "New_Block")

'declare array of objects

ReDim objColl(0 To exportObjSet.Count - 1) As Object

'fill array with selected objects

For MyItemCounter = 0 To exportObjSet.Count - 1

Set objColl(MyItemCounter) = exportObjSet.Item(MyItemCounter)

Next

'copy array to the newly created block definition

thisdrawing.CopyObjects objColl, blockObj

'delete selected objects / may to uncomment this line if you need it!

'oSset.Erase

blkName2 = "New_Block"

Set blkRef = thisdrawing.ModelSpace.InsertBlock(insPtx, blkName2, 1, 1, 1, 0)

'create a new selectionset and add the block to it

ReDim entityarray(0) As AcadEntity

On Error Resume Next

thisdrawing.SelectionSets("EXPORTSET").Delete

Set exportObjSet = thisdrawing.SelectionSets.Add("EXPORTSET")

exportObjSet.Clear

On Error GoTo 0

ReDim Preserve entityarray(0) As AcadEntity

Set entityarray(0) = blkRef

exportObjSet.AddItems entityarray

thisdrawing.Wblock "C:\SL-DWG\" & grpName & ".dwg", exportObjSet

blkRef.Delete

blockObj.Delete

Next

'hold this no matter what
'''For Each Grp In Groups
'''
''' 'make sure the exportObjSet is cleared each time
''' On Error Resume Next
''' thisdrawing.SelectionSets("EXPORTSET").Delete
''' On Error GoTo 0
''' Set exportObjSet = thisdrawing.SelectionSets.Add("EXPORTSET")
''' exportObjSet.Clear
''' 'create a selection set of solids in the group
''' grpName = Grp.Name
''' ExportCounter = -1
'''
''' For Each Ent In Grp
''' ExportCounter = ExportCounter + 1
''' ReDim Preserve entityarray(ExportCounter) As AcadEntity
''' Set entityarray(ExportCounter) = Ent
''' Next
'''
''' 'now export it
''' exportObjSet.AddItems entityarray
''' thisdrawing.Wblock "C:\SL-DWG\" & grpName & ".dwg", exportObjSet
'''Next

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'all walls are exported
'now to open each and process it
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DocHoldName = thisdrawing.Name
Dim MySolid2 As Acad3DSolid

For Each Grp In Groups

grpName = Grp.Name

'now open the file and

thisdrawing.Application.Documents.Open "C:\SL-DWG\" & grpName & ".dwg"

Set ThisDrawing2 = thisdrawing.Application.ActiveDocument

DocHoldName2 = ThisDrawing2.Name

Set ThisDrawing2 = Application.Documents(DocHoldName2)

ThisDrawing2.Activate

'temp code

Dim TempBlock As AcadBlockReference

Dim TempBlock2 As AcadBlockReference

WallTotalSize = 0

For Each Ent In ThisDrawing2.ModelSpace

If Ent.ObjectName = "AcDbBlockReference" Then

Set TempBlock = Ent

TempBlock.GetBoundingBox minExt, maxExt

WallTotalSize = maxExt(0) - minExt(0)

TempBlock.explode

End If

Next

GetOut:

'process it

For Each Ent In ThisDrawing2.ModelSpace

TempPartName = UCase(getXdataInformation2(Ent.Handle, "PartName", ThisDrawing2))

If TempPartName = "COMMON-STUD" Then

Set MyWSolid = Ent

'Get its matrix here

'then transform them all out of this loop

Dim DataTypeC1(0 To 4) As Integer

Dim DataC1(0 To 4) As Variant

getXdataInformation3 MyWSolid.Handle, "MILLLISTER", ThisDrawing2

AppName = AppName

HoldVecO = HoldVecO

HoldVecX = HoldVecX

HoldVecY = HoldVecY

HoldVecZ = HoldVecZ

DataC1(0) = AppName

DataC1(1) = ObjOrigin

DataC1(2) = HoldVecX

DataC1(3) = HoldVecY

DataC1(4) = HoldVecZ

'build a matrix from the data:

variantX = DataC1(2)

variantY = DataC1(3)

variantZ = DataC1(4)

X1 = variantX(0)

X2 = variantX(1)

X3 = variantX(2)

Y1 = variantY(0)

Y2 = variantY(1)

Y3 = variantY(2)

Z1 = variantZ(0)

Z2 = variantZ(1)

Z3 = variantZ(2)

Erase ReturnMatrix

ReturnMatrix(0, 0) = X1: ReturnMatrix(0, 1) = X2: ReturnMatrix(0, 2) = X3: ReturnMatrix(0, 3) = 0#

ReturnMatrix(1, 0) = Y1: ReturnMatrix(1, 1) = Y2: ReturnMatrix(1, 2) = Y3: ReturnMatrix(1, 3) = 0#

ReturnMatrix(2, 0) = Z1: ReturnMatrix(2, 1) = Z2: ReturnMatrix(2, 2) = Z3: ReturnMatrix(2, 3) = 0#

ReturnMatrix(3, 0) = 0#: ReturnMatrix(3, 1) = 0#: ReturnMatrix(3, 2) = 0#: ReturnMatrix(3, 3) = 1#

'its done getting it, so get out

GoTo TransformAll

End If

Next

TransformAll:

For Each Ent In ThisDrawing2.ModelSpace

If Ent.ObjectName "AcDbBlockReference" Then

Ent.Delete

End If
Next

For Each Ent In ThisDrawing2.ModelSpace

Ent.TransformBy (ReturnMatrix)

Ent.Update

'rotate everything about the z

Dim rotatePt1(0 To 2) As Double

Dim rotatePt2(0 To 2) As Double

Dim rotateAngle As Double

rotatePt1(0) = 0

rotatePt1(1) = 0

rotatePt1(2) = 0

rotatePt2(0) = 0

rotatePt2(1) = 0

rotatePt2(2) = 1

rotateAngle = 90

rotateAngle = rotateAngle * 3.14159265358979 / 180#

Ent.Rotate3D rotatePt1, rotatePt2, rotateAngle

Ent.Update
Next

'moving this here to check wall size
''''''''''''''''''''''''''''''''''''''''''

WallTotalSize = 0
For Each Ent In ThisDrawing2.ModelSpace

If Ent.ObjectName = "AcDbBlockReference" Then

Set TempBlock = Ent

TempBlock.GetBoundingBox minExt, maxExt

WallTotalSize = maxExt(0) - minExt(0)

End If
Next

For Each Ent In ThisDrawing2.ModelSpace

If Ent.ObjectName = "AcDbBlockReference" Then

Set TempBlock = Ent

TempBlock.explode

'TempBlock.Delete

End If
Next

For Each Ent In ThisDrawing2.ModelSpace

If Ent.ObjectName = "AcDbBlockReference" Then

Set TempBlock = Ent

TempBlock.Delete

GoTo MyOut

End If
Next
MyOut:

'delete all entites not on the layers I want!!
For Each Ent In ThisDrawing2.ModelSpace

If Ent.Layer "0-FOAM" Or Ent.Layer "0-HEADER" Or _

Ent.Layer "0-TRACK" Or Ent.Layer "0-CNR-METAL" Or _

Ent.Layer "0-CMN-STUD" Then

Ent.Delete

End If
Next

Dim Starter(0 To 2) As Double
Dim Ender(0 To 2) As Double
Starter(0) = 0
Starter(1) = 0
Starter(2) = 0
Ender(0) = 10000
Ender(1) = 10000
Ender(2) = -10000

'move everything over on x y z
For Each Ent In ThisDrawing2.ModelSpace

Ent.Move Starter, Ender
Next

'insert the titleblock
Dim MyBlock As AcadBlockReference
Dim path As String
Dim insPt3(0 To 2) As Double

If WallTotalSize 377.5 Then
' path = "C:\Program Files\SmartLister07\sample files\Wall-Layout-Block814.dwg"
' UseTitleSize = 1
'End If

If WallTotalSize > 377.5 Then

path = "C:\Program Files\SmartLister07\sample files\Wall-Layout-Block1117.dwg"

UseTitleSize = 1
End If

insPt3(0) = 0#: insPt3(1) = 0#: insPt3(2) = 0#
On Error GoTo 0
ThisDrawing2.Layouts("Layout1").block.InsertBlock insPt3, path, 1, 1, 1, 0

'block.explode and delete
ThisDrawing2.ActiveSpace = acPaperSpace

For Each Ent In ThisDrawing2.PaperSpace

If Ent.ObjectName = "AcDbBlockReference" Then

Set MyBlock = Ent

MyBlock.explode

ZoomAll

GoTo Out

End If
Next
Out:

For Each Ent In ThisDrawing2.PaperSpace

If Ent.ObjectName = "AcDbBlockReference" Then

Set MyBlock = Ent

MyBlock.Delete

ZoomAll

GoTo Out2

End If
Next
Out2:

'AcadApp2.Application.Update
'delete unneed reference objects
For Each Ent In ThisDrawing2.PaperSpace

If Ent.ObjectName = "AcDbRotatedDimension" Or Ent.ObjectName = "AcDbMText" Then

If Ent.Layer = "temp" Then

Ent.Delete

End If

End If
Next

ThisDrawing2.SendCommand "zoom " & "e "

'go to modelspace and GET THE dims for diming in paperspace
ThisDrawing2.ActiveSpace = acModelSpace
ThisDrawing2.SendCommand "-dimstyle " & "r " & "dimsize1" & vbCr
ThisDrawing2.SendCommand "-style " & "size1" & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr

DoWLDims ThisDrawing2

'go to paperspace and set a viewport with the contents
Dim LayerName As AcadLayer
Dim pviewportObj1 As AcadPViewport
Dim currLayer As AcadLayer
Dim center(0 To 2) As Double
Dim width As Double
Dim height As Double

Set currLayer = ThisDrawing2.ActiveLayer

ThisDrawing2.ActiveSpace = acPaperSpace
ThisDrawing2.SendCommand "zoom " & "e "
ThisDrawing2.MSpace = False

Dim ViewCenter(0 To 2) As Double
If UseTitleSize = 0 Then

center(0) = 4.7028: center(1) = 3.9555: center(2) = 0

width = 9.125

height = 7.6875

ZoomExtents

ViewCenter(0) = center(0)

ViewCenter(1) = center(1)

ViewCenter(2) = center(2)
End If

'If UseTitleSize = 1 Then
' center(0) = 6.2028: center(1) = 3.9555: center(2) = 0
' width = 12.125
' height = 7.6875
' ZoomExtents
' ViewCenter(0) = center(0)
' ViewCenter(1) = center(1)
' ViewCenter(2) = center(2)
'End If

If UseTitleSize = 1 Then

center(0) = 7.625: center(1) = 5.1875: center(2) = 0

width = 14.875

height = 10.125

ZoomExtents

ViewCenter(0) = center(0)

ViewCenter(1) = center(1)

ViewCenter(2) = center(2)
End If

ThisDrawing2.Layers.Add ("vports")
ThisDrawing2.ActiveLayer = ThisDrawing2.Layers("vports")
ThisDrawing2.ActiveLayer.Color = acGreen

Set pviewportObj1 = ThisDrawing2.PaperSpace.AddPViewport(center, width, height)
pviewportObj1.Update
pviewportObj1.Display (True)

Dim removeHidden As Boolean
pviewportObj1.ShadePlot = acShadePlotHidden
pviewportObj1.Update

ThisDrawing2.SendCommand "mview " & "hideplot " & "on " & "all " & " "
ThisDrawing2.MSpace = True
ThisDrawing2.ActivePViewport = pviewportObj1
ThisDrawing2.SendCommand "zoom " & "e "
ZoomScaled 2.08333333333333E-02, acZoomScaledRelativePSpace

ThisDrawing2.SendCommand "hideprecision " & "1 "
ThisDrawing2.MSpace = False
ThisDrawing2.PaperSpace.Layout.PlotType = acExtents
ThisDrawing2.PaperSpace.Layout.StandardScale = ac1_1

Set Layouts = ThisDrawing2.Layouts

Dim Layout As AcadLayout
Dim mediaNames As Variant
Dim t As Integer

If UseTitleSize = 0 Then

For Each Layout In Layouts

Layout.ConfigName = "KIP All-Other Systems 8.5 x 11.pc3"

mediaNames = ThisDrawing2.ActiveLayout.GetCanonicalMediaNames

Layouts("Layout1").C
onfigName = "KIP All-Other Systems 8.5 x 11.pc3"

ThisDrawing2.PaperSpace.Layout.ConfigName = "KIP All-Other Systems 8.5 x 11.pc3"

ThisDrawing2.ActiveLayout.CanonicalMediaName = "ANSI_A_(11.00_x_8.50_Inches)" 'mediaNames(t)

ThisDrawing2.ActiveLayout.RefreshPlotDeviceInfo

Next
End If

'If UseTitleSize = 1 Then
' For Each Layout In Layouts
' Layout.ConfigName = "KIP All-Other Systems 8.5 x 14.pc3"
' mediaNames = ThisDrawing2.ActiveLayout.GetCanonicalMediaNames
' Layouts("Layout1").ConfigName = "KIP All-Other Systems 8.5 x 14.pc3"
' ThisDrawing2.PaperSpace.Layout.ConfigName = "KIP All-Other Systems 8.5 x 14.pc3"
' ThisDrawing2.ActiveLayout.CanonicalMediaName = "UserDefinedImperial (14.00 x 8.50Inches)" 'mediaNames(t)
' ThisDrawing2.ActiveLayout.RefreshPlotD' ThisDrawing2.ActiveLayout.RefreshPlotDeviceInfo
' Next
'End If

If UseTitleSize = 1 Then

For Each Layout In Layouts

Layout.ConfigName = "KIP All-Other Systems 11 x 17.pc3"

mediaNames = ThisDrawing2.ActiveLayout.GetCanonicalMediaNames

Layouts("Layout1").C
onfigName = "KIP All-Other Systems 11 x 17.pc3"

ThisDrawing2.PaperSpace.Layout.ConfigName = "KIP All-Other Systems 11 x 17.pc3"

ThisDrawing2.ActiveLayout.CanonicalMediaName = "ANSI_B_(17.00_x_11.00_Inches)" 'mediaNames(t)

ThisDrawing2.ActiveLayout.RefreshPlotDeviceInfo

Next
End If

Layouts("Layout1").StyleSheet = "C:\Program Files\SmartLister07\sample files\new2.ctb"
Layouts("Layout1").PlotRotation = ac0degrees

Dim MyOrigin(0 To 1) As Double
MyOrigin(0) = 0.5 * 25.4
MyOrigin(1) = 0.09 * 25.4

Layouts("Layout1").PlotOrigin = MyOrigin
ThisDrawing2.PaperSpace.Layout.PlotOrigin = MyOrigin
ThisDrawing2.Layers("vports").LayerOn = False
ThisDrawing2.ActiveLayer = ThisDrawing2.Layers("0-DIMENSION")
Set MyActiveLayer = ThisDrawing2.ActiveLayer

ThisDrawing2.SendCommand "-style " & "size4" & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr
'edit titleblock
Dim mtextObjx As AcadMText
Dim insertPointx(0 To 2) As Double
Dim widthx As Double
Dim textStringx As String

If UseTitleSize = 0 Then

insertPointx(0) = 9.5
End If

'If UseTitleSize = 1 Then
' insertPointx(0) = 12.5
'End If

If UseTitleSize = 1 Then

insertPointx(0) = 15.4375
End If

insertPointx(1) = 0.625
insertPointx(2) = 0
widthx = 10
textStringx = grpName
Set mtextObjx = ThisDrawing2.PaperSpace.AddMText(insertPointx, widthx, textStringx)
mtextObjx.height = 0.125

If UseTitleSize = 0 Then

insertPointx(0) = 9.5

insertPointx(1) = 1.625
End If

'If UseTitleSize = 1 Then
' insertPointx(0) = 12.5
'End If

If UseTitleSize = 1 Then

insertPointx(0) = 15.4375

insertPointx(1) = 2
End If

'insertPointx(1) = 1.625
insertPointx(2) = 0
widthx = 10
textStringx = UCase(PubJobName)
Set mtextObjx = ThisDrawing2.PaperSpace.AddMText(insertPointx, widthx, textStringx)
mtextObjx.height = 0.125
rotatePt1(0) = insertPointx(0)
rotatePt1(1) = insertPointx(1)
rotatePt1(2) = 0
rotatePt2(0) = insertPointx(0)
rotatePt2(1) = insertPointx(1)
rotatePt2(2) = 1
rotateAngle = 90
rotateAngle = rotateAngle * 3.14159265358979 / 180#
mtextObjx.Rotate3D rotatePt1, rotatePt2, rotateAngle
mtextObjx.Update

'add the drawn by
If UseTitleSize = 0 Then

insertPointx(0) = 9.5

insertPointx(1) = insertPointx(1) - 0.5
End If

'If UseTitleSize = 1 Then
' insertPointx(0) = 12.5
'End If

If UseTitleSize = 1 Then

insertPointx(0) = 15.375

insertPointx(1) = insertPointx(1) - 0.55
End If

insertPointx(2) = 0
widthx = 10
textStringx = UCase(DrawnName)
Set mtextObjx = ThisDrawing2.PaperSpace.AddMText(insertPointx, widthx, textStringx)
mtextObjx.height = 0.125

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'back up code
'debug mode
'add dims to array
'change dim style

'need to make public type arrays for the dims, might as well add the dim style in there?

'revisit bookmarks on that delete block issue. I may not have to loop that twice, two times!!!

'make floorplan code
'make wall process choice
'add wall number to wall builder

'now add the dims
For Each Ent In ThisDrawing2.ModelSpace

If LCase(Ent.ObjectName) = "acdb3dsolid" Then

Set MySolid = Ent

momentOfInertia = MySolid.Centroid

momentOfInertia(2) = 0

GoTo Jumpouter

End If
Next
Jumpouter:

'leave the originals in model space for now
Dim Dpoint1(0 To 2) As Double
Dim Dpoint2(0 To 2) As Double
Dim Dlocation(0 To 2) As Double
Dim dimObj As AcadDimAligned
Dim dimObj2 As AcadDimAligned
Dim P1 As Variant
Dim P2 As Variant
Dim M1 As Variant
Dim M2 As Variant
Dim PSpt As AcadPoint, MSpt As AcadPoint
Dim util As AcadUtility

'a little trick because im too stupid to fill M1 as a variant it otherwise
M1 = momentOfInertia

Set util = ThisDrawing2.Utility

Dim FixDim(0 To 2) As Double
Dim DimHandles() As String

'HORZ. DIMS BOTTOM
For D = 0 To UBound(DimArray)

Dpoint1(0) = DimArray(D).Point1X

Dpoint1(1) = DimArray(D).Point1Y '- 0.125

Dpoint1(2) = DimArray(D).Point1Z

Dpoint2(0) = DimArray(D).Point2X

Dpoint2(1) = DimArray(D).Point2Y '- 0.125

Dpoint2(2) = DimArray(D).Point2Z

Dlocation(0) = DimArray(D).CenterX

Dlocation(1) = DimArray(D).CenterY '- (5.125 + AddAmount)

Dlocation(2) = DimArray(D).CenterZ

M1(0) = Dpoint1(0)

M1(1) = Dpoint1(1)

M1(2) = Dpoint1(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint1(0) = P1(0)

Dpoint1(1) = P1(1)

Dpoint1(2) = P1(2)

M1(0) = Dpoint2(0)

M1(1) = Dpoint2(1)

M1(2) = Dpoint2(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint2(0) = P1(0)

Dpoint2(1) = P1(1)

Dpoint2(2) = P1(2)

M1(0) = Dlocation(0)

M1(1) = Dlocation(1)

M1(2) = Dlocation(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dlocation(0) = P1(0)

Dlocation(1) = P1(1) - 0.375

Dlocation(2) = P1(2)

Set dimObj = ThisDrawing2.PaperSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)

'add its handle to an array

ReDim Preserve DimHandles(D)

DimHandles(D) = dimObj.Handle
Next

DimArrayCounter2 = -1
Dim BaseYPosition As Double
BaseYPosition = 100000

'open the exemptlist and add it to an array
Dim ExemptArray() As Double
Dim ExemptArrayCounter As Integer
ExemptArrayCounter = -1
Dim ReadValue As Double
Dim FileName As String
Dim sLine As String
Dim ReturnText As String
Dim F As Integer
Dim G As Integer

F = FreeFile
FileName = "C:\Program Files\SmartLister07\exemptlist.txt"

'If Right(App.path, 1) = "\" Then
' FileName = App.path & "exemptlist.txt"
'Else
' FileName = App.path & "\exemptlist.txt"
'End If

Open FileName For Input As #F
ExemptArrayCounter = -1
Do Until EOF(F)
Line Input #F, sLine
sLine = LCase(sLine)
ReadValue = CDbl(Trim(sLine))

ExemptArrayCounter = ExemptArrayCounter + 1
ReDim Preserve ExemptArray(ExemptArrayCounter)

ExemptArray(ExemptArrayCounter) = ReadValue
Loop
Close #F

Dim TotalFlats As Integer
TotalFlats = 0
Dim FarRightFlat1 As Integer
FarRightFlat1 = 0
Dim FarRightFlat2 As Integer
FarRightFlat2 = 0
Dim FarRightFlat3 As Integer
FarRightFlat3 = 0
Dim FarLeftFlat1 As Integer
FarLeftFlat1 = 0
Dim FarLeftFlat2 As Integer
FarLeftFlat2 = 0
Dim FarLeftFlat3 As Integer
FarLeftFlat3 = 0
Dim CenterFlat As Integer
CenterFlat = 0
Dim dConvert As Double
Dim BB As Integer
For BB = 0 To UBound(DimHandles)

Set dimObj = ThisDrawing2.HandleToObject(DimHandles(BB))

DimArrayCounter2 = DimArrayCounter2 + 1

ReDim Preserve DimArray2(DimArrayCounter2)

DimArray2(DimArrayCounter2).Handle = dimObj.Handle

DimArray2(DimArrayCounter2).Measurement = dimObj.Measurement

DimArray2(DimArrayCounter2).Adjusted = 0

DimArray2(DimArrayCounter2).Adjustable = 1

DimArray2(DimArrayCounter2).OriginalXlocation = dimObj.TextPosition(0)

DimArray2(DimArrayCounter2).OriginalYlocation = dimObj.TextPosition(1)

DimArray2(DimArrayCounter2).OriginalZlocation = dimObj.TextPosition(2)

DimArray2(DimArrayCounter2).TextLocationX = dimObj.TextPosition(0)

DimArray2(DimArrayCounter2).TextLocationY = dimObj.TextPosition(1)

DimArray2(DimArrayCounter2).TextLocationZ = dimObj.TextPosition(2)

DimArray2(DimArrayCounter2).Point1X = dimObj.ExtLine1Point(0)

DimArray2(DimArrayCounter2).Point1Y = dimObj.ExtLine1Point(1)

DimArray2(DimArrayCounter2).Point1Z = dimObj.ExtLine1Point(2)

DimArray2(DimArrayCounter2).Point2X = dimObj.ExtLine2Point(0)

DimArray2(DimArrayCounter2).Point2Y = dimObj.ExtLine2Point(1)

DimArray2(DimArrayCounter2).Point2Z = dimObj.ExtLine2Point(2)

If dimObj.TextPosition(1) = 32 Then

DimArray2(DimArrayCounter2).Adjustable = 0

TotalFlats = TotalFlats + 1

If BB = UBound(DimHandles) Then 'im at the far right

FarRightFlat1 = 1

ElseIf BB = 0 Then

FarLeftFlat1 = 1

End If

If UBound(DimHandles) > 0 Then

If BB = UBound(DimHandles) - 1 Then 'im at the far right -1

FarRightFlat2 = 1

ElseIf BB = 1 Then

FarLeftFlat2 = 1

End If

End If

If UBound(DimHandles) > 1 Then

If BB = UBound(DimHandles) - 2 Then 'im at the far right -2

FarRightFlat3 = 1

ElseIf BB = 2 Then

FarLeftFlat3 = 1

End If

End If

GoTo Marked

End If
''''''''''

If DimArray2(DimArrayCounter2).Measurement = 15 Then

For G = 0 To UBound(ExemptArray)

If Round(dConvert, 4) = Round(ExemptArray(G), 4) Then

DimArray2(DimArrayCounter2).Adjustable = 0

TotalFlats = TotalFlats + 1

If BB = UBound(DimHandles) Then 'im at the far right

FarRightFlat1 = 1

ElseIf BB = 0 Then

FarLeftFlat1 = 1

End If

If UBound(DimHandles) > 0 Then

If BB = UBound(DimHandles) - 1 Then 'im at the far right -1

FarRightFlat2 = 1

ElseIf BB = 1 Then

FarLeftFlat2 = 1

End If

End If

If UBound(DimHandles) > 1 Then

If BB = UBound(DimHandles) - 2 Then 'im at the far right -2

FarRightFlat3 = 1

ElseIf BB = 2 Then

FarLeftFlat3 = 1

End If

End If

End If

Next

End If
Marked:
Next

'now go through the dim array in reverse and adjust them
'if the dim count is 3 or more, I can look for a centered flat spot
'go through the array and look for the flat furtherest to the right
'and hold its number

'change this to look for the flat just past center
Dim LowestY As Double
LowestY = 10000
Dim Steps As Integer
Steps = 0
Dim MaxSteps As Integer
MaxSteps = 0

'i need the center here. Perhaps the viewport center can work
Dim FlatBeenSet As Integer
FlatBeenSet = 0
Dim ClosetestToCenter As Double
ClosetestToCenter = 100000

G = UBound(DimArray2)
Do While G > -1

If DimArray2(G).Adjustable = 0 Then

If DimArray2(G).OriginalXlocation > ViewCenter(0) Then

If DimArray2(G).OriginalXlocation - ViewCenter(0) 0 Then

G = CenterFlat

If UBound(DimHandles) > 0 Then

Do While G > -1

If DimArray2(G).Adjustable = 1 Then

Steps = Steps + 1

Set dimObj = ThisDrawing2.HandleToObject(DimArray2(G).Handle)

Set dimObj2 = ThisDrawing2.HandleToObject(DimArray2(G + 1).Handle)

'get the previous dim y text location and add to it

If DimArray2(G + 1).Adjustable = 0 Then

FixDim(0) = dimObj.TextPosition(0)

FixDim(1) = dimObj.TextPosition(1)

FixDim(2) = 0

dimObj.TextPosition = FixDim

Else

FixDim(0) = dimObj.TextPosition(0)

FixDim(1) = dimObj2.TextPosition(1) - 0.15

FixDim(2) = 0

dimObj.TextPosition = FixDim

End If

Else

Steps = 0

End If

If Steps > MaxSteps Then

MaxSteps = Steps

End If

G = G - 1

Loop

End If

'now work my way out the other way
'read other direction and move the x too!!!

'G = CenterFlat

If UBound(DimHandles) > 0 Then

For G = CenterFlat To UBound(DimArray2)

If DimArray2(G).Adjustable = 1 Then

Steps = Steps + 1

Set dimObj = ThisDrawing2.HandleToObject(DimArray2(G).Handle)

Set dimObj2 = ThisDrawing2.HandleToObject(DimArray2(G - 1).Handle)

'get the previous dim y text location and add to it

If DimArray2(G - 1).Adjustable = 0 Then

If DimArray2(G - 1).Measurement >= 55 Then

FixDim(0) = dimObj.TextPosition(0) - 0.55606028

FixDim(1) = dimObj.TextPosition(1)

FixDim(2) = 0

dimObj.TextPosition = FixDim

Else

FixDim(0) = dimObj.TextPosition(0) - 0.55606028

FixDim(1) = dimObj.TextPosition(1)

FixDim(2) = 0

dimObj.TextPosition = FixDim

End If

End If

'''''''''''''''''''''''''''''''''''''''''''

If DimArray2(G - 1).Adjustable = 1 Then

If DimArray2(G - 1).Measurement >= 30.9375 Then

FixDim(0) = dimObj.TextPosition(0) - 0.55606028

FixDim(1) = dimObj.TextPosition(1)

FixDim(2) = 0

dimObj.TextPosition = FixDim

Else

FixDim(0) = dimObj.TextPosition(0) - 0.55606028

FixDim(1) = dimObj2.TextPosition(1) - 0.15

FixDim(2) = 0

dimObj.TextPosition = FixDim

'Steps = Steps + 1

End If

End If

Else

Steps = 0

End If

If Steps > MaxSteps Then

MaxSteps = Steps

End If

Next

End If

GoTo HorzDimsAdjusted
End If

'jump over below it code above ran
'else run the code below and kill the extention line so it looks acceptable

Option2:
'going backwards
G = UBound(DimArray2)
Do While G > -1

If DimArray2(G).Adjustable = 0 Then

DimArray2(G).TextLocationY = DimArray2(G).OriginalYlocation

G = G - 1

'don't mod it, and leave it

GoTo ExitThis1

End If

If DimArray2(G).Adjustable = 1 Then

DimArray2(G).TextLocationY = DimArray2(G).OriginalYlocation

'flip it backwards if previous is flat and big enough

Set dimObj = ThisDrawing2.HandleToObject(DimArray2(G).Handle)

If G > 0 Then

Set dimObj2 = ThisDrawing2.HandleToObject(DimArray2(G - 1).Handle)

End If

Steps = Steps + 1

'may bug out on 1' think i fixed it

If G > 0 Then

If DimArray2(G - 1).Measurement >= 30.9375 Then

If DimArray2(G - 1).Adjustable = 0 Then

FixDim(0) = dimObj.TextPosition(0) - 0.55606028

FixDim(1) = dimObj.TextPosition(1)

FixDim(2) = 0

dimObj.TextPosition = FixDim

If Steps > MaxSteps Then

MaxSteps = Steps

End If

End If

Else

'its smaller and wont fit period! Flip it right

'its already there

If Steps > MaxSteps Then

MaxSteps = Steps

End If

End If

G = G - 1

'get its baseline
End If
If G = 0 Then

'its smaller and wont fit period! Flip it right

'its already there
End If

GoTo ExitThis1

End If
Loop
ExitThis1:

Dim ModLeg As Integer
ModLeg = 0

If UBound(DimHandles) > 0 Then

Do While G > -1

If DimArray2(G).Adjustable = 1 Then

Set dimObj = ThisDrawing2.HandleToObject(DimArray2(G).Handle)

Set dimObj2 = ThisDrawing2.HandleToObject(DimArray2(G + 1).Handle)

Steps = Steps + 1

'get the previous dim y text location and add to it

If DimArray2(G + 1).Adjustable = 0 Then

FixDim(0) = dimObj.TextPosition(0) ' + 0.25

FixDim(1) = dimObj.TextPosition(1)

FixDim(2) = 0

dimObj.TextPosition = FixDim

'ModLeg = 0

Else

FixDim(0) = dimObj.TextPosition(0) ' + 0.25

FixDim(1) = dimObj2.TextPosition(1) - 0.15

FixDim(2) = 0

dimObj.TextPosition = FixDim

End If

Else

Steps = 0

End If

If Steps > MaxSteps Then

MaxSteps = Steps

End If

G = G - 1

Loop
End If

'now mod the leg!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'.30176714
'.55606028
HorzDimsAdjusted:

If TrackExists = 0 Then

'MsgBox "There is no track on wall " & grpName & ". Dimensions will not be placed."

GoTo SkipDims
End If

'single y, left placement
Dpoint1(0) = SingleYLeftPlacement1(0)
Dpoint1(1) = SingleYLeftPlacement1(1)
Dpoint1(2) = 0
Dpoint2(0) = SingleYLeftPlacement2(0)
Dpoint2(1) = SingleYLeftPlacement2(1)
Dpoint2(2) = 0
Dlocation(0) = SingleYLeftPlacementlocation(0)
Dlocation(1) = SingleYLeftPlacementlocation(1)
Dlocation(2) = 0

M1(0) = Dpoint1(0)
M1(1) = Dpoint1(1)
M1(2) = Dpoint1(2)
P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
Dpoint1(0) = P1(0)
Dpoint1(1) = P1(1)
Dpoint1(2) = P1(2)

M1(0) = Dpoint2(0)
M1(1) = Dpoint2(1)
M1(2) = Dpoint2(2)
P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
Dpoint2(0) = P1(0)
Dpoint2(1) = P1(1)
Dpoint2(2) = P1(2)

M1(0) = Dlocation(0)
M1(1) = Dlocation(1)
M1(2) = Dlocation(2)
P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
Dlocation(0) = P1(0) - 0.375
Dlocation(1) = P1(1)
Dlocation(2) = P1(2)

Set dimObj = ThisDrawing2.PaperSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)

'OverAllYlocation
If UseOverAll = 1 Then

Dpoint1(0) = OverAllY1(0)

Dpoint1(1) = OverAllY1(1)

Dpoint1(2) = 0

Dpoint2(0) = OverAllY2(0)

Dpoint2(1) = OverAllY2(1)

Dpoint2(2) = 0

Dlocation(0) = OverAllYlocation(0)

Dlocation(1) = OverAllYlocation(1)

Dlocation(2) = 0

M1(0) = Dpoint1(0)

M1(1) = Dpoint1(1)

M1(2) = Dpoint1(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint1(0) = P1(0)

Dpoint1(1) = P1(1)

Dpoint1(2) = P1(2)

M1(0) = Dpoint2(0)

M1(1) = Dpoint2(1)

M1(2) = Dpoint2(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint2(0) = P1(0)

Dpoint2(1) = P1(1)

Dpoint2(2) = P1(2)

M1(0) = Dlocation(0)

M1(1) = Dlocation(1)

M1(2) = Dlocation(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

If dimObj.Measurement 0 Then

'overall x, bottom placement

Dpoint1(0) = OverAllX1(0)

Dpoint1(1) = OverAllX1(1)

Dpoint1(2) = 0

Dpoint2(0) = OverAllX2(0)

Dpoint2(1) = OverAllX2(1)

Dpoint2(2) = 0

Dlocation(0) = OverAllXlocation(0)

Dlocation(1) = OverAllXlocation(1)

Dlocation(2) = 0

M1(0) = Dpoint1(0)

M1(1) = Dpoint1(1)

M1(2) = Dpoint1(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint1(0) = P1(0)

Dpoint1(1) = P1(1)

Dpoint1(2) = P1(2)

M1(0) = Dpoint2(0)

M1(1) = Dpoint2(1)

M1(2) = Dpoint2(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint2(0) = P1(0)

Dpoint2(1) = P1(1)

Dpoint2(2) = P1(2)

M1(0) = Dlocation(0)

M1(1) = Dlocation(1)

M1(2) = Dlocation(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dlocation(0) = P1(0)

If MaxSteps = 0 Then

Dlocation(1) = P1(1) - 0.67676714 '- 0.375 '.375 = aligned with others

End If

If MaxSteps = 1 Then

Dlocation(1) = P1(1) - (0.67676714 + 0.15) '- 0.375

End If

If MaxSteps > 1 Then

Dlocation(1) = P1(1) - (0.67676714 + 0.15 + (0.15 * MaxSteps))

End If

Dlocation(2) = P1(2)

Set dimObj = ThisDrawing2.PaperSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)

dimObj.ExtLine1Suppress = False

dimObj.ExtLine2Suppress = False

dimObj.ExtLineFixedLen = 5

If ModLeg = 1 Then

dimObj.ExtLine2Suppress = True

End If
End If

'0.30176714

Dim TestCollisionPoint(0 To 2) As Double
Dim u As Integer
Dim ModuleText As String
widthx = 0.75
Dim PreviousModulePoint(0 To 2) As Double
Dim P As Integer
Dim dist As Double
Dim dist2 As Double
Dim Xme As Double
Dim Yme As Double
Dim Zme As Double

'OverAllAngle placment
Dpoint1(0) = OverAllAngle1(0)
Dpoint1(1) = OverAllAngle1(1)
Dpoint1(2) = 0
Dpoint2(0) = OverAllAngle2(0)
Dpoint2(1) = OverAllAngle2(1)
Dpoint2(2) = 0
Dlocation(0) = OverAllAnglelocation(0)
Dlocation(1) = OverAllAnglelocation(1)
Dlocation(2) = 0

M1(0) = Dpoint1(0)
M1(1) = Dpoint1(1)
M1(2) = Dpoint1(2)
P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
Dpoint1(0) = P1(0)
Dpoint1(1) = P1(1)
Dpoint1(2) = P1(2)

M1(0) = Dpoint2(0)
M1(1) = Dpoint2(1)
M1(2) = Dpoint2(2)
P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
Dpoint2(0) = P1(0)
Dpoint2(1) = P1(1)
Dpoint2(2) = P1(2)

M1(0) = Dlocation(0)
M1(1) = Dlocation(1)
M1(2) = Dlocation(2)
P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
Dlocation(0) = P1(0)
Dlocation(1) = P1(1)
Dlocation(2) = P1(2)

Set dimObj = ThisDrawing2.PaperSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)

TestCollisionPoint(0) = Dlocation(0)

TestCollisionPoint(1) = Dlocation(1)

TestCollisionPoint(2) = Dlocation(2)

SkipDims:

'module placment
P = 1
If ModuleArrayCounter > -1 Then

For u = 0 To UBound(ModuleArray)

If P = 1 Then

P = 0

Else

P = 1

End If

Dpoint1(0) = ModuleArray(u).PointX

Dpoint1(1) = ModuleArray(u).PointY

Dpoint1(2) = 0

ModuleText = ModuleArray(u).StringName

M1(0) = Dpoint1(0)

M1(1) = Dpoint1(1)

M1(2) = Dpoint1(2)

P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)

P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)

Dpoint1(0) = P1(0) - 0.375

Dpoint1(1) = P1(1)

Dpoint1(2) = P1(2)

'test for center collision

' Xme = Dpoint1(0) - TestCollisionPoint(0)
' Yme = Dpoint1(1) - TestCollisionPoint(1)
' Zme = Dpoint1(2) - TestCollisionPoint(2)
' dist = Sqr((Sqr((Xme ^ 2) + (Yme ^ 2)) ^ 2) + (Zme ^ 2))

'check the one before it

'if it is to the left of the dim, move it left and up .25
' If u 0 Then
' Xme = Dpoint1(0) - PreviousModulePoint(0)
' Yme = Dpoint1(1) - PreviousModulePoint(1)
' Zme = Dpoint1(2) - PreviousModulePoint(2)
' dist2 = Sqr((Sqr((Xme ^ 2) + (Yme ^ 2)) ^ 2) + (Zme ^ 2))
' End If
'
'
' If u 0 Then
' If dist2 TestCollisionPoint(0) Then
' If Dpoint1(0) - TestCollisionPoint(0) TestCollisionPoint(0) Then
''' If Dpoint1(0) - TestCollisionPoint(0) UBound(FilesArrayCheck) Then GoTo ExitNow

If FileCountx < 0 Then

MsgBox "There are no more previous drawing files to review."

GoTo ExitNow
End If

importFile = FilesArrayCheck(FileCountx)
tmpFilename = importFile
thisdrawing.Application.Documents.Open importFile
Set ThisDrawing2 = thisdrawing.Application.ActiveDocument
teststring2 = ThisDrawing2.Name
Text2.Text = str(FileCountx + 1)
ZoomExtents
GoTo ExitNow2

ExitNow:
IsOpeningDrawing = False
Unload Me

ExitNow2:
IsOpeningDrawing = False
End Sub

10/30/13       #16: Automataic dim setup ...
David Wishengrad

'This is called by the code above. I missed adding it in the original comment

Public Sub DoWLDims(ByRef Entity As AcadDocument)

'Set AutoCAD_Application = AcadApp
Set Entity = AutoCAD_Application.ActiveDocument

Dim MyDimLayerName As String
MyDimLayerName = "0-DIMENSION"
Dim MyLayerName As String
Dim MyTempPoly As AcadLWPolyline
Dim MyPolyCopy As AcadLWPolyline
Dim MyLayer As AcadLayer
Dim MyPolyCenter(0 To 1) As Double
Dim Ent As AcadEntity
Dim minExt As Variant
Dim maxExt As Variant
Dim MyPolyMinY As Double
Dim MyPolyMaxY As Double
Dim MyPolyMinX As Double
Dim MyPolyMaxX As Double
Dim DimLine As AcadLine
Dim DimLineCenter(0 To 1) As Double
Dim DimLineStartPoint(0 To 2) As Double
Dim DimLineEndPoint(0 To 2) As Double
Dim DimLinePlacePoint(0 To 2) As Double
Dim MyLinePosition As String
Dim rotAngle As Double
Dim dimObjR As AcadDimRotated
Dim dimObj As AcadDimAligned
Dim Dpoint1(0 To 2) As Double
Dim Dpoint2(0 To 2) As Double
Dim Dlocation(0 To 2) As Double
Dim DimPoly As AcadLWPolyline
Dim MyDimArrayCenters1() As Double
Dim MyDimArrayCenters2() As Double
Dim MyDimArrayCounter As Integer
Dim xs As Double
Dim ys As Double
Dim zs As Double
Dim G As Integer
Dim H As Integer
Dim PreviousValue As Double
Dim CurrentValue As Double
Dim UseValue As Double
Dim SmallestValue As Double
Dim TenStep As Integer
Dim MSolid As Acad3DSolid
Dim MinX As Double
Dim MinY As Double
Dim MaxX As Double
Dim MaxY As Double
Dim MostMinX As Double
Dim MostMinY As Double
Dim MostMaxX As Double
Dim MostMaxY As Double
Dim mtextObjx As AcadMText
Dim insertPointx(0 To 2) As Double
Dim widthx As Double
Dim textStringx As String

'Dim MostMinY As Double
'Dim MostMaxX As Double
'Dim MostMaxY As Double

MostMinX = 10000000
MostMinY = 10000000
MostMaxX = -10000000
MostMaxY = -10000000

Entity.SendCommand "1 "
Entity.SendCommand "z " '& "e "
Entity.SendCommand "e "

If WallTotalSize 377.5 Then

ThisDrawing2.SendCommand "-dimstyle " & "r " & "dimsize1" & vbCr

ThisDrawing2.SendCommand "-style " & "size1" & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr

UseTitleSize = 1
End If

'
Dim AddAmount As Double
AddAmount = 0
'If WallTotalSize >= 150 And WallTotalSize = 300 Then
' ThisDrawing2.SendCommand "-dimstyle " & "r " & "dimsize3" & vbCr
' ThisDrawing2.SendCommand "-style " & "size3" & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr
' AddAmount = 10
'End If

Dim TestFoamExists As Integer
TestFoamExists = 0

'find the mostminx and mostminy

For Each Ent In Entity.ModelSpace

If Ent.ObjectName = "AcDb3dSolid" And Ent.Layer = "0-FOAM" Then

TestFoamExists = 1

Set MSolid = Ent

MSolid.GetBoundingBox minExt, maxExt

xs = maxExt(0) - minExt(0)

ys = maxExt(1) - minExt(1)

zs = maxExt(2) - minExt(2)

xs = Round(xs, 5)

ys = Round(ys, 5)

zs = Round(zs, 5)

MinX = Round(minExt(0), 5)

MinY = Round(minExt(1), 5)

MaxX = Round(maxExt(0), 5)

MaxY = Round(maxExt(1), 5)

If MinX MostMaxX Then

MostMaxX = MaxX

End If

If MaxY > MostMaxY Then

MostMaxY = MaxY

End If

End If
Next

If TestFoamExists = 0 Then

GoTo NoFoam

End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'build an array of all the foam left to right, then by z

Dim MinPnt As Variant
Dim MaxPnt As Variant
Dim HoldHandleID As String
Dim XLeftHold As Double
Dim ZLeftHold As Double
Dim XRightHold As Double
Dim ZRightHold As Double
Dim FoamBlockArray() As typFoamBlockArray
Dim FoamBlockArray2() As typFoamBlockArray
'Dim FoamBlockArrayCounter As Integer
Dim LHoldNumber As Integer
Dim FoamBlockArrayCounter2 As Integer
Dim D As Integer
Dim E As Integer

FoamBlockArrayCounter = -1
For Each Ent In Entity.ModelSpace

If Ent.ObjectName = "AcDb3dSolid" And Ent.Layer = "0-FOAM" Then

Set MSolid = Ent

MSolid.GetBoundingBox MinPnt, MaxPnt

FoamBlockArrayCounter = FoamBlockArrayCounter + 1

ReDim Preserve FoamBlockArray(FoamBlockArrayCounter)

FoamBlockArray(FoamBlockArrayCounter).Han
dle = MSolid.Handle

FoamBlockArray(FoamBlockArrayCounter).MinX = Round(MinPnt(0), 8)

FoamBlockArray(FoamBlockArrayCounter).MinY = Round(MinPnt(1), 8)

FoamBlockArray(FoamBlockArrayCounter).MinZ = Round(MinPnt(2), 8)

FoamBlockArray(FoamBlockArrayCounter).MaxX = Round(MaxPnt(0), 8)

FoamBlockArray(FoamBlockArrayCounter).MaxY = Round(MaxPnt(1), 8)

FoamBlockArray(FoamBlockArrayCounter).MaxZ = Round(MaxPnt(2), 8)

FoamBlockArray(FoamBlockArrayCounter).Used = 0

End If
Next

FoamBlockArrayCounter2 = -1
StartOver:

XLeftHold = 1000000000
ZLeftHold = 1000000000
XRightHold = -1000000000
ZRightHold = -1000000000
Dim TempZLeftHold As Double
Dim L As Integer
Dim M As Integer

LHoldNumber = -1
For L = 0 To UBound(FoamBlockArray)

If Round(FoamBlockArray(L).MinX, 2) -1 Then

FoamBlockArrayCounter2 = FoamBlockArrayCounter2 + 1

ReDim Preserve FoamBlockArray2(FoamBlockArrayCounter2)

FoamBlockArray2(FoamBlockArrayCounter2)
.Handle = FoamBlockArray(LHoldNumber).Handle

FoamBlockArray2(FoamBlockArrayCounter2).MinX
= FoamBlockArray(LHoldNumber).MinX

FoamBlockArray2(FoamBlockArrayCounter2).MinY = FoamBlockArray(LHoldNumber).MinY

FoamBlockArray2(FoamBlockArrayCounter2).MinZ = FoamBlockArray(LHoldNumber).MinZ

FoamBlockArray2(FoamBlockArrayCounter2).MaxX = FoamBlockArray(LHoldNumber).MaxX

FoamBlockArray2(FoamBlockArrayCounter2).MaxY = FoamBlockArray(LHoldNumber).MaxY

FoamBlockArray2(FoamBlockArrayCounter2).MaxZ = FoamBlockArray(LHoldNumber).MaxZ

FoamBlockArray2(FoamBlockArrayCounter2).Used = 1

FoamBlockArray(LHoldNumber).Used = 1

GoTo StartOver
End If
Finished:

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''

'blocks are in array
'build a new array of all the dims needed
'skipping dupes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'p
ublic this
'Dim DimArray() As typDimArray
'Dim DimArrayCounter As Integer
DimArrayCounter = -1
'Dim FirstDone As Integer
FirstDone = 0

For D = 0 To UBound(FoamBlockArray2)

If FirstDone = 0 Then
AddIt1:

DimArrayCounter = DimArrayCounter + 1

ReDim Preserve DimArray(DimArrayCounter)

DimArray(DimArrayCounter).Point1X = Round(FoamBlockArray2(D).MinX, 5)

DimArray(DimArrayCounter).Point1Y = Round(FoamBlockArray2(0).MinY, 5)

DimArray(DimArrayCounter).Point1Z = 0

DimArray(DimArrayCounter).Point2X = Round(FoamBlockArray2(D).MaxX, 5)

DimArray(DimArrayCounter).Point2Y = Round(FoamBlockArray2(0).MinY, 5)

DimArray(DimArrayCounter).Point2Z = 0

DimArray(DimArrayCounter).CenterX = Round(((FoamBlockArray2(D).MinX + FoamBlockArray2(D).MaxX)) / 2, 5)

DimArray(DimArrayCounter).CenterY = Round(FoamBlockArray2(0).MinY, 5)

DimArray(DimArrayCounter).CenterZ = 0

FirstDone = 1

Else

If Round(FoamBlockArray2(D).MinX, 5) Round(FoamBlockArray2(D - 1).MinX, 5) Then

GoTo AddIt1

End If

End If
Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
Entity.Layers.Add ("0-DIMENSION")
Entity.ActiveLayer = Entity.Layers("0-DIMENSION")
Set MyActiveLayer = Entity.ActiveLayer
MyActiveLayer.Color = 222

'HORZ. DIMS BOTTOM
'For D = 0 To UBound(DimArray)
' Dpoint1(0) = DimArray(D).Point1X
' Dpoint1(1) = DimArray(D).Point1Y - 0.125
' Dpoint1(2) = DimArray(D).Point1Z
'
' Dpoint2(0) = DimArray(D).Point2X
' Dpoint2(1) = DimArray(D).Point2Y - 0.125
' Dpoint2(2) = DimArray(D).Point2Z
'
' Dlocation(0) = DimArray(D).CenterX
' Dlocation(1) = DimArray(D).CenterY - (5.125 + AddAmount)
' Dlocation(2) = DimArray(D).CenterZ
'
' Set dimObj = Entity.ModelSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)
'Next

'find all the blocks on far left
'then place a dim for each on left
Dim MyId As String
Dim WriteSoild As Acad3DSolid
'Erase DimArray
DimArrayCounter = -1

Dim FarLeftTopX As Double
Dim FarLeftTopY As Double
Dim FarLeftBottomX As Double
Dim FarLeftBottomY As Double
Dim FarRightTopX As Double
Dim FarRightTopY As Double
Dim FarRightBottomX As Double
Dim FarRightBottomY As Double
FarLeftTopX = 10000000
FarLeftBottomX = 10000000
FarLeftTopY = -10000000
FarLeftBottomY = 10000000
FarRightTopX = -10000000
FarRightBottomX = -10000000
FarRightTopY = -10000000
FarRightBottomY = 10000000

Dim textStringx2 As String
textStringx2 = ""
For Each Ent In Entity.ModelSpace

textStringx = UCase(getXdataInformation2(Ent.Handle, "PartName", Entity))

'textStringx2 = UCase(getXdataInformation2(Ent.Handle, "EB1", Entity))

If textStringx = "TRACK" Then

MyId = Ent.ObjectID

GetmyPoints MyId, Entity

'find the far left point of each track

For L = 0 To UBound(SolidInfo)

For M = 0 To UBound(SolidInfo(L).points) Step 3

If Round(SolidInfo(L).points(M), 5) FarLeftTopY Then

FarLeftTopY = Round(SolidInfo(L).points(M + 1), 5)

End If

If Round(SolidInfo(L).points(M), 5) > FarRightBottomX Then

FarRightBottomX = Round(SolidInfo(L).points(M), 5)

End If

If Round(SolidInfo(L).points(M), 5) > FarRightTopX Then

FarRightTopX = Round(SolidInfo(L).points(M), 5)

End If

If Round(SolidInfo(L).points(M + 1), 5) FarRightTopY Then

FarRightTopY = Round(SolidInfo(L).points(M + 1), 5)

End If

Next

Next

End If
Next

Dim TopTrackLeftMax As Double
TopTrackLeftMax = -10000000
Dim TopTrackRightMax As Double
TopTrackRightMax = -10000000

'Dim TrackExists As Integer
TrackExists = 0
For Each Ent In Entity.ModelSpace

textStringx = UCase(getXdataInformation2(Ent.Handle, "PartName", Entity))

'textStringx2 = UCase(getXdataInformation2(Ent.Handle, "EB1", Entity))

If textStringx = "TRACK" Then

TrackExists = 1

MyId = Ent.ObjectID

GetmyPoints MyId, Entity

For L = 0 To UBound(SolidInfo)

For M = 0 To UBound(SolidInfo(L).points) Step 3

'i need to find the left and right top tracks most upper

'outside points on x and y

If Round(SolidInfo(L).points(M), 5) = FarLeftTopX Then

If Round(SolidInfo(L).points(M + 1), 5) > TopTrackLeftMax Then

TopTrackLeftMax = Round(SolidInfo(L).points(M + 1), 5)

End If

End If

If Round(SolidInfo(L).points(M), 5) = FarRightTopX Then

If Round(SolidInfo(L).points(M + 1), 5) > TopTrackRightMax Then

TopTrackRightMax = Round(SolidInfo(L).points(M + 1), 5)

End If

End If

Next

Next

End If
Next

If TrackExists = 0 Then

'MsgBox "There is no track on wall " & grpName & ". Dimensions will not be placed."

GoTo SkipDims
End If

'single y, left placement
Dpoint1(0) = FarLeftBottomX
Dpoint1(1) = FarLeftBottomY
Dpoint1(2) = 0
Dpoint2(0) = FarLeftTopX
Dpoint2(1) = TopTrackLeftMax
Dpoint2(2) = 0
Dlocation(0) = FarLeftBottomX '- (5 + AddAmount)
Dlocation(1) = (FarLeftBottomY + TopTrackLeftMax) / 2
Dlocation(2) = 0

SingleYLeftPlacement1(0) = Dpoint1(0)
SingleYLeftPlacement1(1) = Dpoint1(1)
SingleYLeftPlacement1(2) = Dpoint1(2)

SingleYLeftPlacement2(0) = Dpoint2(0)
SingleYLeftPlacement2(1) = Dpoint2(1)
SingleYLeftPlacement2(2) = Dpoint2(2)

SingleYLeftPlacementlocation(0) = Dlocation(0)
SingleYLeftPlacementlocation(1) = Dlocation(1)
SingleYLeftPlacementlocation(2) = Dlocation(2)

'Set dimObj = Entity.ModelSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)

'overall y, left placement
UseOverAll = 0
If FarLeftTopY TopTrackLeftMax Then

UseOverAll = 1

Dpoint1(0) = FarLeftBottomX

Dpoint1(1) = FarLeftBottomY

Dpoint1(2) = 0

Dpoint2(0) = FarLeftTopX

Dpoint2(1) = FarLeftTopY

Dpoint2(2) = 0

Dlocation(0) = FarLeftBottomX '- (10 + AddAmount)

Dlocation(1) = (FarLeftBottomY + FarLeftTopY) / 2

Dlocation(2) = 0

OverAllY1(0) = Dpoint1(0)

OverAllY1(1) = Dpoint1(1)

OverAllY1(2) = Dpoint1(2)

OverAllY2(0) = Dpoint2(0)

OverAllY2(1) = Dpoint2(1)

OverAllY2(2) = Dpoint2(2)

OverAllYlocation(0) = Dlocation(0)

OverAllYlocation(1) = Dlocation(1)

OverAllYlocation(2) = Dlocation(2)

' Set dimObj = Entity.ModelSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)
End If

'overall x, bottom placement
If FoamBlockArrayCounter > 0 Then

Dpoint1(0) = FarLeftBottomX

Dpoint1(1) = FarLeftBottomY

Dpoint1(2) = 0

Dpoint2(0) = FarRightBottomX

Dpoint2(1) = FarRightBottomY

Dpoint2(2) = 0

Dlocation(0) = (FarLeftBottomX + FarRightBottomX) / 2

Dlocation(1) = FarLeftBottomY '- (10 + AddAmount + AddAmount)

Dlocation(2) = 0

OverAllX1(0) = Dpoint1(0)

OverAllX1(1) = Dpoint1(1)

OverAllX1(2) = Dpoint1(2)

OverAllX2(0) = Dpoint2(0)

OverAllX2(1) = Dpoint2(1)

OverAllX2(2) = Dpoint2(2)

OverAllXlocation(0) = Dlocation(0)

OverAllXlocation(1) = Dlocation(1)

OverAllXlocation(2) = Dlocation(2)

'Set dimObj = Entity.ModelSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)
End If

'overall angle, bottom left to top right
Dpoint1(0) = FarLeftBottomX
Dpoint1(1) = FarLeftBottomY
Dpoint1(2) = 0
Dpoint2(0) = FarRightTopX
Dpoint2(1) = TopTrackRightMax
Dpoint2(2) = 0
Dlocation(0) = (FarLeftBottomX + FarRightBottomX) / 2
Dlocation(1) = (FarRightBottomY + TopTrackRightMax) / 2
Dlocation(2) = 0

OverAllAngle1(0) = Dpoint1(0)
OverAllAngle1(1) = Dpoint1(1)
OverAllAngle1(2) = Dpoint1(2)

OverAllAngle2(0) = Dpoint2(0)
OverAllAngle2(1) = Dpoint2(1)
OverAllAngle2(2) = Dpoint2(2)

OverAllAnglelocation(0) = Dlocation(0)
OverAllAnglelocation(1) = Dlocation(1)
OverAllAnglelocation(2) = Dlocation(2)

'Set dimObj = Entity.ModelSpace.AddDimAligned(Dpoint1, Dpoint2, Dlocation)

SkipDims:

'Public Type typModuleArray
' PointX As Double
' PointY As Double
' PointZ As Double
' StringName As String
'End Type
'Public ModuleArray() As typModuleArray
'Public ModuleArrayCounter As Integer

ModuleArrayCounter = -1
'module#
For Each Ent In Entity.ModelSpace

If Ent.ObjectName = "AcDb3dSolid" And Ent.Layer = "0-FOAM" Then

Set MSolid = Ent

MSolid.GetBoundingBox minExt, maxExt

xs = maxExt(0) - minExt(0)

ys = maxExt(1) - minExt(1)

zs = maxExt(2) - minExt(2)

xs = Round(xs, 5)

ys = Round(ys, 5)

zs = Round(zs, 5)

MinX = Round(minExt(0), 5)

MinY = Round(minExt(1), 5)

MaxX = Round(maxExt(0), 5)

MaxY = Round(maxExt(1), 5)

insertPointx(0) = Round((MinX + MaxX) / 2, 4) - 13

insertPointx(1) = Round((MinY + MaxY) / 2, 4)

insertPointx(2) = 5000

widthx = 26

textStringx = UCase(getXdataInformation2(MSolid.Handle, "EB2", Entity))

ModuleArrayCounter = ModuleArrayCounter + 1

ReDim Preserve ModuleArray(ModuleArrayCounter)

ModuleArray(ModuleArrayCounter).PointX = Round((MinX + MaxX) / 2, 4)

ModuleArray(ModuleArrayCounter).PointY = Round((MinY + MaxY) / 2, 4)

ModuleArray(ModuleArrayCounter).PointZ = 0

ModuleArray(ModuleArrayCounter).StringName = textStringx

' Create a text Object in model space

' Set mtextObjx = Entity.ModelSpace.AddMText(insertPointx, widthx, textStringx)

End If
Next

Entity.ActiveLayer = Entity.Layers("0")
Set MyActiveLayer = Entity.ActiveLayer

NoFoam:

End Sub


Post a Response
  • Notify me of responses to this thread
  • Subscribe to email updates on this Forum
  • To receive email notification of additions to this forum thread,
    enter your name and email address, and then click the
    "Keep Me Posted" button below.

    Please Note: If you have posted a message or response,
    do not submit this request ... you are already signed up
    to receive notification!

    Your Name:
    E-Mail Address:
    Enter the correct numbers into the field below:
     

    Date of your Birth:



    Return to top of page

    Buy & Sell Exchanges | Forums | Galleries | Site Map

    FORUM GUIDELINES: Please review the guidelines below before posting at WOODWEB's Interactive Message Boards (return to top)

  • WOODWEB is a professional industrial woodworking site. Hobbyist and homeowner woodworking questions are inappropriate.
  • Messages should be kept reasonably short and on topic, relating to the focus of the forum. Responses should relate to the original question.
  • A valid email return address must be included with each message.
  • Advertising is inappropriate. The only exceptions are the Classified Ads Exchange, Machinery Exchange, Lumber Exchange, and Job Opportunities and Services Exchange. When posting listings in these areas, review the posting instructions carefully.
  • Subject lines may be edited for length and clarity.
  • "Cross posting" is not permitted. Choose the best forum for your question, and post your question at one forum only.
  • Messages requesting private responses will be removed - Forums are designed to provide information and assistance for all of our visitors. Private response requests are appropriate at WOODWEB's Exchanges and Job Opportunities and Services.
  • Messages that accuse businesses or individuals of alleged negative actions or behavior are inappropriate since WOODWEB is unable to verify or substantiate the claims.
  • Posts with the intent of soliciting answers to surveys are not appropriate. Contact WOODWEB for more information on initiating a survey.
  • Excessive forum participation by an individual upsets the balance of a healthy forum atmosphere. Individuals who excessively post responses containing marginal content will be considered repeat forum abusers.
  • Responses that initiate or support inappropriate and off-topic discussion of general politics detract from the professional woodworking focus of WOODWEB, and will be removed.
  • Participants are encouraged to use their real name when posting. Intentionally using another persons name is prohibited, and posts of this nature will be removed at WOODWEB's discretion.
  • Comments, questions, or criticisms regarding Forum policies should be directed to WOODWEB's Systems Administrator
    (return to top).

    Carefully review your message before clicking on the "Send Message" button - you will not be able to revise the message once it has been sent.

    You will be notified of responses to the message(s) you posted via email. Be sure to enter your email address correctly.

    WOODWEB's forums are a highly regarded resource for professional woodworkers. Messages and responses that are crafted in a professional and civil manner strengthen this resource. Messages that do not reflect a professional tone reduce the value of our forums.

    Messages are inappropriate when their content: is deemed libelous in nature or is based on rumor, fails to meet basic standards of decorum, contains blatant advertising or inappropriate emphasis on self promotion (return to top).

    Libel:   Posts which defame an individual or organization, or employ a tone which can be viewed as malicious in nature. Words, pictures, or cartoons which expose a person or organization to public hatred, shame, disgrace, or ridicule, or induce an ill opinion of a person or organization, are libelous.

    Improper Decorum:   Posts which are profane, inciting, disrespectful or uncivil in tone, or maliciously worded. This also includes the venting of unsubstantiated opinions. Such messages do little to illuminate a given topic, and often have the opposite effect. Constructive criticism is acceptable (return to top).

    Advertising:   The purpose of WOODWEB Forums is to provide answers, not an advertising venue. Companies participating in a Forum discussion should provide specific answers to posted questions. WOODWEB suggests that businesses include an appropriately crafted signature in order to identify their company. A well meaning post that seems to be on-topic but contains a product reference may do your business more harm than good in the Forum environment. Forum users may perceive your references to specific products as unsolicited advertising (spam) and consciously avoid your web site or services. A well-crafted signature is an appropriate way to advertise your services that will not offend potential customers. Signatures should be limited to 4-6 lines, and may contain information that identifies the type of business you're in, your URL and email address (return to top).

    Repeated Forum Abuse: Forum participants who repeatedly fail to follow WOODWEB's Forum Guidelines may encounter difficulty when attempting to post messages.

    There are often situations when the original message asks for opinions: "What is the best widget for my type of shop?". To a certain extent, the person posting the message is responsible for including specific questions within the message. An open ended question (like the one above) invites responses that may read as sales pitches. WOODWEB suggests that companies responding to such a question provide detailed and substantive replies rather than responses that read as a one-sided product promotion. It has been WOODWEB's experience that substantive responses are held in higher regard by our readers (return to top).

    The staff of WOODWEB assume no responsibility for the accuracy, content, or outcome of any posting transmitted at WOODWEB's Message Boards. Participants should undertake the use of machinery, materials and methods discussed at WOODWEB's Message Boards after considerate evaluation, and at their own risk. WOODWEB reserves the right to delete any messages it deems inappropriate. (return to top)


  • Forum Posting Help
    Your Name The name you enter in this field will be the name that appears with your post or response (return to form).
    Your Website Personal or business website links must point to the author's website. Inappropriate links will be removed without notice, and at WOODWEB's sole discretion. WOODWEB reserves the right to delete any messages with links it deems inappropriate. (return to form)
    E-Mail Address Your e-mail address will not be publicly viewable. Forum participants will be able to contact you using a contact link (included with your post) that is substituted for your actual address. You must include a valid email address in this field. (return to form)
    Subject Subject may be edited for length and clarity. Subject lines should provide an indication of the content of your post. (return to form)
    Thread Related Link and Image Guidelines Thread Related Links posted at WOODWEB's Forums and Exchanges should point to locations that provide supporting information for the topic being discussed in the current message thread. The purpose of WOODWEB Forums is to provide answers, not to serve as an advertising venue. A Thread Related Link that directs visitors to an area with inappropriate content will be removed. WOODWEB reserves the right to delete any messages with links or images it deems inappropriate. (return to form)
    Thread Related File Uploads Thread Related Files posted at WOODWEB's Forums and Exchanges should provide supporting information for the topic being discussed in the current message thread. Video Files: acceptable video formats are: .MOV .AVI .WMV .MPEG .MPG .MP4 (Image Upload Tips)   If you encounter any difficulty when uploading video files, E-mail WOODWEB for assistance. The purpose of WOODWEB Forums is to provide answers, not to serve as an advertising venue. A Thread Related File that contains inappropriate content will be removed, and uploaded files that are not directly related to the message thread will be removed. WOODWEB reserves the right to delete any messages with links, files, or images it deems inappropriate. (return to form)