Private Function insertPostInfo(ByVal file As String, ByVal thickness As String, ByVal joblength As String, ByVal width As String, ByVal material As String, ByVal description As String, ByVal prototype As String, ByVal total As String, ByVal comment As String) If secondInsertion Then jobFile = file thick = thickness length = joblength w = width jobMaterial = material descript = description proto = prototype jobTotal = total jobComment = comment Return insertPostInfo() End If Me.Hide() Dim fileSplit() As String = file.Split("\") file = fileSplit(fileSplit.Length - 1) Dim lenWid As String If length <> "" And width <> "" Then lenWid = length + " x " + width Else lenWid = "" End If Dim dateString As String = System.DateTime.Now.Date.ToString titleblock = createTitleBlock() Dim layer = createLayer("CNC ATTRIBUTES 0-0") 'Dim layer = createLayer("PostInfo") Dim myDWG As ApplicationServices.Document = Application.DocumentManager.MdiActiveDocument Dim insertPoint = myDWG.Editor.GetPoint("INSERTION POINT IS THE LOWER LEFT CORNER OF THE FRAME").Value iPoint = insertPoint farPoint = insertPoint getSelset(insertPoint) Dim myFactor = 48 Dim myHeight = 0 insertPoint = New Point3d(insertPoint.X, insertPoint.Y - 1, insertPoint.Z) Dim myDB = myDWG.Database Dim myLT As LayerTable = myDB.LayerTableId.GetObject(DatabaseServices.OpenMode.ForRead) If selset Is Nothing Then If type = "Routing" Then MessageBox.Show("No Frame Selected.") Return False ElseIf type = "VMill" Then 'do same as Routing w/ frame, except use manual selection set from PostChanges to determine 'selset rather than automatically doing it myFactor = 50 myHeight = 50 insertRectangle(layer, insertPoint, myFactor) Dim insertions As Point3dCollection = getInsertions(insertPoint, myFactor) Dim textFactor As Double = myFactor / 35 insertTextElements(insertions, layer, textFactor, myFactor, myHeight, lenWid) secondInsertion = True 'allow user to scale the block Using myTrans As Transaction = myDWG.TransactionManager.StartTransaction Try Dim myObjIDs(attribute.Count) As ObjectId For i As Integer = 0 To insertions.Count - 1 Dim entity As DatabaseServices.Entity = Nothing Dim item As ObjectId = Nothing item = attribute(i) myObjIDs(i) = item entity = myTrans.GetObject(item, OpenMode.ForRead) Next Dim myEntity As DatabaseServices.Entity = Nothing Dim myItem = Nothing myItem = postRectangle myObjIDs(insertions.Count) = myItem myEntity = myTrans.GetObject(myItem, OpenMode.ForRead) selset = EditorInput.SelectionSet.FromObjectIds(myObjIDs) highlightSelset() sendScaleCommand() Catch ex As Exception End Try myTrans.Commit() End Using 'If the right way doesn't work, this is backup 'Dim myScalePoint = myDWG.Editor.GetPoint("CHOOSE THE POINT WHERE YOU WANT THE BOTTOM RIGHT-HAND CORNER OF THE TITLE BLOCK:").Value 'deleteInsertionBlock() 'secondInsertion = False 'myFactor = myScalePoint.X - insertPoint.X 'myHeight = insertPoint.Y - myScalePoint.Y 'insertRectangle(layer, insertPoint, myFactor) 'insertions = getInsertions(insertPoint, myFactor) 'textFactor = myFactor / 35 'insertTextElements(insertions, layer, textFactor, myFactor, myHeight, lenWid) 'secondInsertion = True Return True End If ElseIf selset.Count = 1 Then Using myTrans As Transaction = myDWG.TransactionManager.StartTransaction Try Dim myEntity As DatabaseServices.Entity = Nothing Dim myItem = Nothing myItem = selset.Item(0).ObjectId myEntity = myTrans.GetObject(myItem, OpenMode.ForRead) If myEntity.Layer = "CNC_T_B" Then MessageBox.Show("One of your profiles is on the title layer. Please change it in order to continue.") Return False Else lockedLayer = myTrans.GetObject(myLT(myEntity.Layer), OpenMode.ForWrite) lockedLayer.IsLocked = True End If myFactor = myEntity.GeometricExtents.MaxPoint.X - myEntity.GeometricExtents.MinPoint.X myHeight = myEntity.GeometricExtents.MaxPoint.Y - myEntity.GeometricExtents.MinPoint.Y 'iPoint.Subtract(New Vector3d(0, myHeight, 0)) farPoint.Add(New Vector3d(myFactor, 0, 0)) materialSize = myFactor & " x " & myHeight Catch ex As Exception MessageBox.Show("AutoCAD has issues with getting and locking the frame") End Try myTrans.Commit() End Using insertRectangle(layer, insertPoint, myFactor) Dim insertions As Point3dCollection = getInsertions(insertPoint, myFactor) Dim textFactor As Double = myFactor / 35 insertTextElements(insertions, layer, textFactor, myFactor, myHeight, lenWid) secondInsertion = True Return True Else MessageBox.Show("No Operations Frame selected") Return False End If Return False End Function Private Sub sendScaleCommand() Dim ObjAcad As AcadApplication = DirectCast(GetObject(, "AutoCAD.Application.18"), AcadApplication) ObjAcad.ActiveDocument.SendCommand("_scale " + vbCr) End Sub