Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - fixo

Pages: [1] 2 3 ... 9
1
Text / Change the background mask property of AcDbMText object programmatically
« on: Yesterday at 08:36:35 PM »

See for more an article written  by Fenton Webb here
http://adndevblog.typepad.com/autocad/2013/05/change-the-background-mask-property-of-acdbmtext-object-programmatically-using-objectarx.html
   VB.NET
   
Code: [Select]
        Public Shared Function fixoGetEntity(tr As Transaction, ed As Editor, rx As RXClass, msg As String, ByRef id As ObjectId) As ErrorStatus
            Dim es As ErrorStatus
            Dim ent As Entity
            id = ObjectId.Null
            Dim peo As New PromptEntityOptions(msg)
            peo.SetRejectMessage(vbLf & "You're missing, try again >>")
            peo.AddAllowedClass(GetType(Entity), False)
            Dim res As PromptEntityResult
            res = ed.GetEntity(peo)
            If res.Status <> PromptStatus.OK Then
                es = ErrorStatus.PointNotOnEntity
            End If
            id = res.ObjectId
            If id = ObjectId.Null Then
                es = ErrorStatus.NullObjectId
            End If
            ent = TryCast(tr.GetObject(id, OpenMode.ForRead, False), Entity)
            If ent.GetRXClass() <> rx Then
                ed.WriteMessage(vbLf & "{0}Must be a type of ""{0}"" only!", rx.DxfName)
                es = ErrorStatus.NotThatKindOfClass
            End If
            If ent Is Nothing Then
                es = ErrorStatus.NotAnEntity
            Else
                es = ErrorStatus.OK
            End If
            Return es
        End Function
        <CommandMethod("BM")> _
        Public Shared Sub test_setBackgroundFill_MText()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim db As Database = HostApplicationServices.WorkingDatabase

            Dim id As ObjectId = ObjectId.Null

            Using tr As Transaction = db.TransactionManager.StartTransaction()
                If fixoGetEntity(tr, ed, RXClass.GetClass(GetType(MText)), vbLf & "Please pick an MText entity: ", id) = ErrorStatus.OK Then

                    Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                    ' get entity by direct cast
                    Dim ent As Entity = DirectCast(tr.GetObject(id, OpenMode.ForRead), Entity)

                    If id.ObjectClass.DxfName = "MTEXT" Then
                        Dim mtx As MText = TryCast(ent, MText)

                        mtx.UpgradeOpen()

                        Dim color As Autodesk.AutoCAD.Colors.Color

                        If mtx.BackgroundFill Then

                            mtx.UseBackgroundColor = False


                            mtx.BackgroundFill = False
                        Else

                            mtx.BackgroundFill = True

                            color = color.FromColorIndex(ColorMethod.ByAci, CInt(1))

                            mtx.BackgroundFillColor = color


                            mtx.UseBackgroundColor = False
                        End If

                        mtx.RecordGraphicsModified(True)
                    End If
                End If
                tr.Commit()
            End Using
        End Sub

   C#
   
Code: [Select]
        public static ErrorStatus fixoGetEntity(Transaction tr, Editor ed, RXClass rx, string msg, out ObjectId id)
        {
            ErrorStatus es;
            Entity ent;
            id = ObjectId.Null;
            PromptEntityOptions peo = new PromptEntityOptions(msg);
            peo.SetRejectMessage("\nYou're missing, try again >>");
            peo.AddAllowedClass(typeof(Entity), false);
            PromptEntityResult res;
            res = ed.GetEntity(peo);
            if (res.Status != PromptStatus.OK)
                es = ErrorStatus.PointNotOnEntity;
            id = res.ObjectId;
            if (id == ObjectId.Null)
                es = ErrorStatus.NullObjectId;
            ent = tr.GetObject(id, OpenMode.ForRead, false) as Entity;
            if (ent.GetRXClass() != rx)
            {
                ed.WriteMessage("\n{0}Must be a type of \"{0}\" only!", rx.DxfName);
                es = ErrorStatus.NotThatKindOfClass;
            }
            if (ent == null)
                es = ErrorStatus.NotAnEntity;
            else es = ErrorStatus.OK;
            return es;
        }
        [CommandMethod("BM")]
        static public void test_setBackgroundFill_MText()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;

            Editor ed = doc.Editor;

            Database db = HostApplicationServices.WorkingDatabase;

            ObjectId id = ObjectId.Null;

            using (Transaction tr = db.TransactionManager.StartTransaction())
            {
                if (fixoGetEntity(tr, ed, RXClass.GetClass(typeof(MText)), "\nPlease pick an MText entity: ", out id) == ErrorStatus.OK)
                {

                    BlockTableRecord btr = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite) as BlockTableRecord;
                   // get entity by direct cast
                    Entity ent = (Entity)tr.GetObject(id, OpenMode.ForRead);

                    if (id.ObjectClass.DxfName == "MTEXT")
                    {
                        MText mtx = ent as MText;

                        mtx.UpgradeOpen();

                        Autodesk.AutoCAD.Colors.Color color;

                        if (mtx.BackgroundFill )
                        {

                            mtx.UseBackgroundColor= false;

                            mtx.BackgroundFill=false;

                        }

                        else
                        {

                            mtx.BackgroundFill=true;

                            color = Color.FromColorIndex(ColorMethod.ByAci, (int)1);

                            mtx.BackgroundFillColor = color;
                           
                            mtx.UseBackgroundColor=false;

                        }

                        mtx.RecordGraphicsModified(true);

                    }
                }
                tr.Commit();
            }
        }

2
Layers / Create new layer by selecting a single object
« on: May 12, 2013, 09:03:47 PM »
      This code example about how to create a new layer that has same properties as the layer that already exist in a drawing,
      by select single entity on existing this layer and then copy properties from

       
Code: [Select]

       [CommandMethod("CopyLayerFromObject")]

        public void testCopyLayer()
        {

            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;

            Database db = doc.Database;

            Editor ed = doc.Editor;

            PromptStringOptions sopts = new PromptStringOptions("\nEnter new layer name :");

            sopts.AllowSpaces = true;

            PromptResult stres = ed.GetString(sopts);

            if (stres.Status != PromptStatus.OK) return;
            // get new layer name
            string layerName = stres.StringResult;

            PromptSelectionOptions opts = new PromptSelectionOptions();

            opts.MessageForRemoval = "Wrong selection, try again.";

            opts.MessageForAdding = "Select single object to copy layer from: ";

            opts.SingleOnly = true;

            opts.SinglePickInSpace = true;
            // select single object
            PromptSelectionResult selRes = ed.GetSelection(opts);

            if (selRes.Status != PromptStatus.OK) return;

            ObjectId entId = selRes.Value.GetObjectIds()[0];

            // open transaction

            using (Transaction tr = db.TransactionManager.StartTransaction())
            {
                LayerTable ltb = (LayerTable)tr.GetObject(db.LayerTableId, OpenMode.ForRead);
                // get entity
                Entity ent = (Entity)tr.GetObject(entId, OpenMode.ForRead);
                // get entity layer
                string oldname = ent.Layer;
                // get LayerTableRecord by name
                LayerTableRecord oldLtr = (LayerTableRecord)tr.GetObject(ltb[oldname], OpenMode.ForRead);
                // check if layer exists
                if (!ltb.Has(layerName))
                {
                    ltb.UpgradeOpen();

                    //create new layer
                    LayerTableRecord ltr = new LayerTableRecord();
                    // copy properties from entity layer
                    ltr.CopyFrom(oldLtr);
                    // add new layer name
                    ltr.Name = layerName;
                    // here you can to add other properties to a layer: linetype, color etc
                    //
                    // add layer to LayerTable
                    ltb.Add(ltr);
                    // confirm transaction
                    tr.AddNewlyCreatedDBObject(ltr, true);

                }
                // end command if layer exist
                else
                {
                    return;
                }

                tr.Commit();

            }//end using transaction

        }

   VB.NET
Code: [Select]
        <CommandMethod("CopyLayerFromObject")> _
        Public Sub testCopyLayer()

            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim db As Database = doc.Database

            Dim ed As Editor = doc.Editor

            Dim sopts As New PromptStringOptions(vbLf & "Enter new layer name :")

            sopts.AllowSpaces = True

            Dim stres As PromptResult = ed.GetString(sopts)

            If stres.Status <> PromptStatus.OK Then
                Return
            End If
            ' get new layer name
            Dim layerName As String = stres.StringResult

            Dim opts As New PromptSelectionOptions()

            opts.MessageForRemoval = "Wrong selection, try again."

            opts.MessageForAdding = "Select single object to copy layer from: "

            opts.SingleOnly = True

            opts.SinglePickInSpace = True
            ' select single object
            Dim selRes As PromptSelectionResult = ed.GetSelection(opts)

            If selRes.Status <> PromptStatus.OK Then
                Return
            End If

            Dim entId As ObjectId = selRes.Value.GetObjectIds()(0)

            ' open transaction

            Using tr As Transaction = db.TransactionManager.StartTransaction()
                Dim ltb As LayerTable = DirectCast(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
                ' get entity
                Dim ent As Entity = DirectCast(tr.GetObject(entId, OpenMode.ForRead), Entity)
                ' get entity layer
                Dim oldname As String = ent.Layer
                ' get LayerTableRecord by name
                Dim oldLtr As LayerTableRecord = DirectCast(tr.GetObject(ltb(oldname), OpenMode.ForRead), LayerTableRecord)
                ' check if layer exists
                If Not ltb.Has(layerName) Then
                    ltb.UpgradeOpen()

                    'create new layer
                    Dim ltr As New LayerTableRecord()
                    ' copy properties from entity layer
                    ltr.CopyFrom(oldLtr)
                    ' add new layer name
                    ltr.Name = layerName
                    ' here you can to add other properties to a layer: linetype, color etc
                    '
                    ' add layer to LayerTable
                    ltb.Add(ltr)
                    ' confirm transaction

                    tr.AddNewlyCreatedDBObject(ltr, True)
                Else
                    ' end command if layer exist
                    Return
                End If

                tr.Commit()
            End Using
            'end using transaction
        End Sub

3
Selection sets / Count total length using LINQ
« on: May 04, 2013, 08:44:36 PM »
   C#       
   
Code: [Select]
        //using System.Linq;
        [CommandMethod("TotalLengthCS")]
        public void testTotalLengthCS()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Editor ed = doc.Editor;
            Database db = doc.Database;
            StringBuilder sb = new StringBuilder();
            sb.AppendLine("\tTotal Length:\n------------------------------------");
            try
            {
                using (Transaction tr = db.TransactionManager.StartTransaction())
                {
                    //------------------------------------------------------------------
                    // Create filter object, this filter can have any types to select, i.e. curves
                    SelectionFilter filter = new SelectionFilter(new TypedValue[]
                    {
                         new TypedValue(0, "LINE,ARC,SPLINE,CIRCLE,ELLIPSE,*POLYLINE") /*, new TypedValue(410, "~Model"),//<-- paper space only//*/
                    }
                    );
                    // Select objects on screen
                    PromptSelectionResult psr = ed.GetSelection(filter);
                    // Check if selection is succeed
                    if (psr.Status != PromptStatus.OK) return;
                    // See here for more: http://code.msdn.microsoft.com/101-LINQ-Samples-3fb9811b        101 LINQ Samples Csharp
// Grouping objects by name with sum of lengths
                       var data =
                            from e in psr.Value.GetObjectIds()
                            let ln= e.GetObject(OpenMode.ForRead) as Curve
                            group ln by ln.GetRXClass().DxfName into g
                            select new { ObjectName = g.Key, Subtotal = g.Sum(x => Math.Abs(x.GetDistanceAtParameter(x.EndParam - x.StartParam))) };

                    foreach (var n in data)
                    {
                        sb.AppendLine(string.Format("{0}\t{1:f6}", n.ObjectName, n.Subtotal));
                    }
                    System.Windows.Forms.MessageBox.Show(sb.ToString());
                }
            }
            catch (System.Exception ex)
            {
                System.Windows.Forms.MessageBox.Show(ex.ToString());

            }
        }

   VB.NET
Code: [Select]
        ''Imports System.Linq
        <CommandMethod("TotalLengthVB")> _
        Public Sub testTotalLengthVB()
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
            Dim sb As New StringBuilder
            sb.AppendLine(vbTab + "Total Length:" + vbTab + "------------------------------------")
            Using tr As Transaction = db.TransactionManager.StartTransaction
                Dim tv() As TypedValue = {New TypedValue(0, "LINE,ARC,SPLINE,CIRCLE,ELLIPSE,*POLYLINE")}
                Dim sf As New SelectionFilter(tv)
                Dim psr As PromptSelectionResult = ed.GetSelection(sf)
                If psr.Status <> PromptStatus.OK Then Return

                ''  See here for more: http://msdn.microsoft.com/en-us/vstudio/bb688088.aspx        101 LINQ Samples VB.NET
                ''  Grouping objects by name with sum of lengths
                Dim subtotals = From id In psr.Value.GetObjectIds _
             Let curve = CType(tr.GetObject(id, OpenMode.ForRead), Curve) _
             Group curve By curve.GetRXClass().DxfName Into grp = Group _
             Select ObjectName = grp.First, Subtotal = grp.Sum(Function(x) Math.Abs(x.GetDistanceAtParameter(x.EndParam - x.StartParam)))

                For Each n In subtotals
                    sb.AppendLine(String.Format("{0}" + vbTab + "{1:f6}", n.ObjectName, n.Subtotal))
                Next

                System.Windows.Forms.MessageBox.Show(sb.ToString())
            End Using
        End Sub

4
Polylines / Creates a rectangle from the mid points of opposing sides
« on: April 27, 2013, 11:40:46 AM »
Creates a rectangle from the mid points of opposing sides and then specify the length of the sides
inspired by  David Bethel
as posted at http://www.cadtutor.net/forum/showthread.php?63494-Lisp-for-rectangle

   C#
Code: [Select]
       
[CommandMethod("P2Sides")]
        public void testDrawRectangleBySides()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Editor ed = doc.Editor;
            Database db = doc.Database;
            PromptPointOptions ppo = new PromptPointOptions("\nCenter of the first side: ");
            PromptPointResult ppr = ed.GetPoint(ppo);
            if (ppr.Status != PromptStatus.OK) return;
            Point3d p1 = ppr.Value;
            ppo = new PromptPointOptions("\nCenter of the seconf side: ");
            ppo.UseBasePoint = true;
            ppo.BasePoint = p1;
            ppo.UseDashedLine = true;
            ppr = ed.GetPoint(ppo);
            if (ppr.Status != PromptStatus.OK) return;

            Point3d p2 = ppr.Value;
            if (p1.X == p2.X || p1.Y == p2.Y)
            {
                ed.WriteMessage("\nInvalid coordinate specification");
                return;
            }
            ed.DrawVector(p1, p2, 1, true);
            PromptDistanceOptions pdo = new PromptDistanceOptions("\nOpposite width: ");
            pdo.BasePoint = p2;
            pdo.DefaultValue = 100;
            pdo.UseDefaultValue = true;
            PromptDoubleResult pdr = ed.GetDistance(pdo);
            if (pdr.Status != PromptStatus.OK) return;
            double leg = p1.DistanceTo(p2);
            double wid = pdr.Value;
            ed.WriteMessage("\n\tLength:\t{0:f3}\tWidth:{1:f3}\n", leg, wid);
            Plane plan = new Plane(Point3d.Origin, Vector3d.ZAxis);
            double ang = p1.GetVectorTo(p2).AngleOnPlane(plan);
            Point3dCollection pts = new Point3dCollection();
            Point3d c1 = PolarPoint(p1, ang - Math.PI / 2, wid / 2);
            Point3d c4 = PolarPoint(p1, ang + Math.PI / 2, wid / 2);
            Point3d c2 = PolarPoint(c1, ang, leg);
            Point3d c3 = PolarPoint(c4, ang, leg);
            pts.Add(c1); pts.Add(c2); pts.Add(c3); pts.Add(c4);
            Polyline poly = new Polyline();
            int idx = 0;
            foreach (Point3d p in pts)
            {
                Point2d pp = new Point2d(p.X, p.Y);
                poly.AddVertexAt(idx, pp, 0, 0, 0);
                idx += 1;
            }
            poly.Closed = true;

            using (Transaction tr = doc.TransactionManager.StartTransaction())
            {
                BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite);
                btr.AppendEntity(poly);
                tr.AddNewlyCreatedDBObject(poly, true);
                tr.Commit();

            }//end using transaction

        }

        // by Tony Tanzillo
        public static Point3d PolarPoint(Point3d basepoint, double angle, double distance)
        {
            return new Point3d(
            basepoint.X + (distance * Math.Cos(angle)),
            basepoint.Y + (distance * Math.Sin(angle)),
            basepoint.Z);
        }


      VB.NET
Code: [Select]
        <CommandMethod("P2Sides")> _
        Public Sub testDrawRectangleBySides()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor = doc.Editor
            Dim db As Database = doc.Database
            Dim ppo As New PromptPointOptions(vbLf & "Center of the first side: ")
            Dim ppr As PromptPointResult = ed.GetPoint(ppo)
            If ppr.Status <> PromptStatus.OK Then
                Return
            End If
            Dim p1 As Point3d = ppr.Value
            ppo = New PromptPointOptions(vbLf & "Center of the seconf side: ")
            ppo.UseBasePoint = True
            ppo.BasePoint = p1
            ppo.UseDashedLine = True
            ppr = ed.GetPoint(ppo)
            If ppr.Status <> PromptStatus.OK Then
                Return
            End If

            Dim p2 As Point3d = ppr.Value
            If p1.X = p2.X OrElse p1.Y = p2.Y Then
                ed.WriteMessage(vbLf & "Invalid coordinate specification")
                Return
            End If
            ed.DrawVector(p1, p2, 1, True)
            Dim pdo As New PromptDistanceOptions(vbLf & "Opposite width: ")
            pdo.BasePoint = p2
            pdo.DefaultValue = 100
            pdo.UseDefaultValue = True
            Dim pdr As PromptDoubleResult = ed.GetDistance(pdo)
            If pdr.Status <> PromptStatus.OK Then
                Return
            End If
            Dim leg As Double = p1.DistanceTo(p2)
            Dim wid As Double = pdr.Value
            ed.WriteMessage(vbLf & vbTab & "Length:" & vbTab & "{0:f3}" & vbTab & "Width:{1:f3}" & vbLf, leg, wid)
            Dim plan As New Plane(Point3d.Origin, Vector3d.ZAxis)
            Dim ang As Double = p1.GetVectorTo(p2).AngleOnPlane(plan)
            Dim pts As New Point3dCollection()
            Dim c1 As Point3d = PolarPoint(p1, ang - Math.PI / 2, wid / 2)
            Dim c4 As Point3d = PolarPoint(p1, ang + Math.PI / 2, wid / 2)
            Dim c2 As Point3d = PolarPoint(c1, ang, leg)
            Dim c3 As Point3d = PolarPoint(c4, ang, leg)
            pts.Add(c1)
            pts.Add(c2)
            pts.Add(c3)
            pts.Add(c4)
            Dim poly As New Polyline()
            Dim idx As Integer = 0
            For Each p As Point3d In pts
                Dim pp As New Point2d(p.X, p.Y)
                poly.AddVertexAt(idx, pp, 0, 0, 0)
                idx += 1
            Next
            poly.Closed = True

            Using tr As Transaction = doc.TransactionManager.StartTransaction()
                Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                btr.AppendEntity(poly)
                tr.AddNewlyCreatedDBObject(poly, True)

                tr.Commit()
            End Using
            'end using transaction
        End Sub

        ' by Tony Tanzillo
        Public Shared Function PolarPoint(basepoint As Point3d, angle As Double, distance As Double) As Point3d
            Return New Point3d(basepoint.X + (distance * Math.Cos(angle)), basepoint.Y + (distance * Math.Sin(angle)), basepoint.Z)
        End Function

5
Blocks / Insert block with attributes by predefined values
« on: April 21, 2013, 04:36:56 PM »
       Insert a block with attributes by predefined values,
       done only limited testing in A2010

 C#
Code: [Select]
     private static void ApplyAttibutes(Database db, Transaction tr, BlockReference bref, List<string> listTags, List<string> listValues)
        {
            BlockTableRecord btr = (BlockTableRecord)tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead);

            foreach (ObjectId attId in btr)
            {
                Entity ent = (Entity)tr.GetObject(attId, OpenMode.ForRead);
                if (ent is AttributeDefinition)
                {
                    AttributeDefinition attDef = (AttributeDefinition)ent;
                    AttributeReference attRef = new AttributeReference();

                    attRef.SetAttributeFromBlock(attDef, bref.BlockTransform);
                    bref.AttributeCollection.AppendAttribute(attRef);
                    tr.AddNewlyCreatedDBObject(attRef, true);
                    if (listTags.Contains(attDef.Tag))
                    {
                        int found = listTags.BinarySearch(attDef.Tag);
                        if (found >= 0)
                        {
                            attRef.TextString = listValues[found];
                            attRef.AdjustAlignment(db);
                        }
                    }

                }
            }
        }

        [CommandMethod("iab")]
        public static void testAttributedBlockInsert()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Database db = doc.Database;
            Editor ed = doc.Editor;
            // change block name to your suit
            string blockName = "UserName";
            Matrix3d ucs = ed.CurrentUserCoordinateSystem;
            //get current UCS matrix
            try
            {
                using (Transaction tr = db.TransactionManager.StartTransaction())
                {
                    // to force update drawing screen
                    doc.TransactionManager.EnableGraphicsFlush(true);
                    BlockTable bt = (BlockTable)tr.GetObject(db.BlockTableId, OpenMode.ForWrite);

                    // if the block table doesn't already exists, exit
                    if (!bt.Has(blockName))
                    {
                        Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Block " + blockName + " does not exist.");
                        return;
                    }

                    // insert the block in the current space
                    PromptPointResult ppr = ed.GetPoint("\nSpecify insertion point: ");
                    if (ppr.Status != PromptStatus.OK)
                    {
                        return;
                    }

                    BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite);
                    ObjectContextCollection occ = db.ObjectContextManager.GetContextCollection("ACDB_ANNOTATIONSCALES");

                    Point3d pt = ppr.Value;
                    BlockReference bref = new BlockReference(pt, bt[blockName]);
                    bref.TransformBy(ucs);
                    bref.AddContext(occ.CurrentContext);

                    //add blockreference to current space
                    btr.AppendEntity(bref);
                    tr.AddNewlyCreatedDBObject(bref, true);
                    // set attributes to desired values
                    ApplyAttibutes(db, tr, bref, new List<string>(new string[] {
"TAG1",
"TAG2",
"TAG3",
"TAG4"
}), new List<string>(new string[] {
"Value #1",
"Value #2",
"Value #3",
"Value #4"
}));


                    bref.RecordGraphicsModified(true);
                    // to force updating a block reference
                    tr.TransactionManager.QueueForGraphicsFlush();
                    tr.Commit();
                }
            }
            catch (Autodesk.AutoCAD.Runtime.Exception ex)
            {
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(ex.Message);
            }
            finally
            {
                // Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Pokey")
            }
        }
   VB.NET
Code: [Select]
  Private Shared Sub ApplyAttibutes(ByRef db As Database, ByRef tr As Transaction, ByVal bref As BlockReference, ByVal listTags As List(Of String), ByVal listValues As List(Of String))
            Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)

            For Each attId As ObjectId In btr
                Dim ent As Entity = DirectCast(tr.GetObject(attId, OpenMode.ForRead), Entity)
                If TypeOf ent Is AttributeDefinition Then
                    Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
                    Dim attRef As New AttributeReference()

                    attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
                    bref.AttributeCollection.AppendAttribute(attRef)
                    tr.AddNewlyCreatedDBObject(attRef, True)
                    If listTags.Contains(attDef.Tag) Then
                        Dim found As Integer = listTags.BinarySearch(attDef.Tag)
                        If found >= 0 Then
                            attRef.TextString = listValues(found)
                            attRef.AdjustAlignment(db)
                        End If
                    End If

                End If
            Next
        End Sub

        <CommandMethod("iab")> _
        Public Shared Sub testAttributedBlockInsert()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            ' change block name to your suit
            Dim blockName As String = "UserName"
            Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem 'get current UCS matrix
            Try
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    ' to force update drawing screen
                    doc.TransactionManager.EnableGraphicsFlush(True)
                    Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForWrite), BlockTable)

                    ' if the block table doesn't already exists, exit
                    If Not bt.Has(blockName) Then
                        Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Block " & blockName & " does not exist.")
                        Return
                    End If

                    ' insert the block in the current space
                    Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Specify insertion point: ")
                    If ppr.Status <> PromptStatus.OK Then
                        Return
                    End If

                    Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                    Dim occ As ObjectContextCollection = db.ObjectContextManager.GetContextCollection("ACDB_ANNOTATIONSCALES")

                    Dim pt As Point3d = ppr.Value
                    Dim bref As New BlockReference(pt, bt(blockName))
                    bref.TransformBy(ucs)
                    bref.AddContext(occ.CurrentContext)

                    'add blockreference to current space
                    btr.AppendEntity(bref)
                    tr.AddNewlyCreatedDBObject(bref, True)
                    ' set attributes to desired values
                    ApplyAttibutes(db, tr, bref, New List(Of String)(New String() {"TAG1", "TAG2", "TAG3", "TAG4"}), New List(Of String)(New String() {"Value #1", "Value #2", "Value #3", "Value #4"}))


                    bref.RecordGraphicsModified(True) ' to force updating a block reference
                    tr.TransactionManager.QueueForGraphicsFlush()
                    tr.Commit()
                End Using
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(ex.Message)
            Finally
                ' Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Pokey")
            End Try
        End Sub

6
Polylines / Merge polylines using SendCommand VB.NET
« on: April 21, 2013, 01:01:59 PM »
    Here is the basic command to merge / subtract closed contours,
   tested on A2010
VB.NET
Code: [Select]
        <CommandMethod("mep", CommandFlags.Session)> _
        Public Shared Sub testUnionPlines()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor = doc.Editor
            Dim db As Database = doc.Database
            ' get argument to choose boolean operation mode
            Dim pko As New PromptKeywordOptions(vbLf & "Choose boolean operation mode " & "[Union/Subtract]: ", "Union Subtract")
            ' The default depends on our current settings
            pko.Keywords.[Default] = "Union"
            Dim pkr As PromptResult = ed.GetKeywords(pko)
            If pkr.Status <> PromptStatus.OK Then
                Return
            End If
            Dim choice As String = pkr.StringResult

            Dim doUnion As Boolean = If(choice = "Union", True, False)
            Dim regLst As New List(Of Region)()
            Dim delPline As New List(Of Polyline)()
            Using doclock As DocumentLock = doc.LockDocument()
                'start a transaction
                Using tr As Transaction = db.TransactionManager.StartTransaction()

                    Dim tvs As TypedValue() = New TypedValue(2) {New TypedValue(0, "lwpolyline"), New TypedValue(-4, "&"), New TypedValue(70, 1)}
                    Dim filter As New SelectionFilter(tvs)
                    Dim pso As New PromptSelectionOptions()
                    pso.MessageForRemoval = vbLf & "Select closed polylines only: "
                    pso.MessageForAdding = vbLf & "Select closed polylines: "
                    Dim result As PromptSelectionResult = ed.GetSelection(filter)
                    If result.Status <> PromptStatus.OK Then
                        Return
                    End If

                    Try
                        Dim sset As SelectionSet = result.Value
                        Dim ids As ObjectId() = sset.GetObjectIds()
                        Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord)
                        Dim objreg1 As New Region()

                        For n As Integer = 0 To ids.Count() - 1

                            Dim obj As DBObject = TryCast(tr.GetObject(ids(n), OpenMode.ForRead), DBObject)
                            Dim pline1 As Polyline = TryCast(obj, Polyline)
                            If pline1 Is Nothing Then
                                Return
                            End If
                            ' Add the polyline to the List to rerase them all at the end of execution
                            delPline.Add(pline1)
                            ' Add the polyline to the array
                            Dim objArray1 As New DBObjectCollection()
                            objArray1.Add(pline1)
                            ' create the 1 st region
                            Dim objRegions1 As New DBObjectCollection()
                            objRegions1 = Region.CreateFromCurves(objArray1)
                            objreg1 = TryCast(objRegions1(0), Region)
                            btr.AppendEntity(objreg1)

                            tr.AddNewlyCreatedDBObject(objreg1, True)

                            objreg1.ColorIndex = 1
                            'optional
                            ' add the region to the List<Region> for the future work
                            regLst.Add(objreg1)
                        Next
                        'ed.WriteMessage("\nCount regions:\t{0}\n", regLst.Count);//just for the debug

                        ' sort regions by areas
                        Dim items As Region() = regLst.ToArray()
                        Array.Sort(items, Function(x As Region, y As Region) y.Area.CompareTo(x.Area))
                        ' get the biggest region first
                        Dim mainReg As Region = items(0)
                        ' ed.WriteMessage("\nMain region area:\t{0:f3}\n", items[0].Area);//just for the debug
                        If Not mainReg.IsWriteEnabled Then
                            mainReg.UpgradeOpen()
                        End If
                        If items.Length = 2 Then

                            If Not doUnion Then
                                mainReg.BooleanOperation(BooleanOperationType.BoolSubtract, DirectCast(items(1), Region))
                            Else
                                mainReg.BooleanOperation(BooleanOperationType.BoolUnite, DirectCast(items(1), Region))
                            End If
                        Else
                            ' starting iteration from the second region
                            Dim i As Integer = 1
                            Do
                                Dim reg1 As Region = items(i)
                                Dim reg2 As Region = items(i + 1)

                                If (reg1 Is Nothing) OrElse (reg2 Is Nothing) Then
                                    Exit Do
                                Else

                                    ' subtract region 1 from region 2
                                    If reg1.Area > reg2.Area Then
                                        ' subtract the smaller region from the larger one
                                        '
                                        reg1.BooleanOperation(BooleanOperationType.BoolUnite, reg2)
                                        If Not doUnion Then
                                            mainReg.BooleanOperation(BooleanOperationType.BoolSubtract, reg1)
                                        Else
                                            mainReg.BooleanOperation(BooleanOperationType.BoolUnite, reg1)

                                        End If
                                    Else


                                        ' subtract the smaller region from the larger one

                                        reg2.BooleanOperation(BooleanOperationType.BoolUnite, reg1)
                                        If Not doUnion Then
                                            mainReg.BooleanOperation(BooleanOperationType.BoolSubtract, reg2)
                                        Else
                                            mainReg.BooleanOperation(BooleanOperationType.BoolUnite, reg2)
                                        End If

                                    End If
                                End If
                                ' increase counter
                                i += 1
                            Loop While i < items.Length - 1
                        End If
                        mainReg.ColorIndex = 1
                        ' put dummy color for region
                        ' erase polylines
                        For Each poly As Polyline In delPline
                            If poly IsNot Nothing Then
                                If Not poly.IsWriteEnabled Then
                                    poly.UpgradeOpen()
                                End If
                                poly.Erase()
                                If Not poly.IsDisposed Then
                                    poly.Dispose()
                                End If
                            End If
                        Next

                        '  ---    explode region and create polyline from exploded entities   ---   //

                        Dim regexpl As New DBObjectCollection()
                        mainReg.Explode(regexpl)

                        Dim exids As New List(Of ObjectId)()

                        ' gather selected object into the List<ObjectId>
                        If regexpl.Count > 0 Then
                            For Each obj As DBObject In regexpl
                                Dim ent As Entity = TryCast(obj, Entity)
                                If ent IsNot Nothing Then
                                    Dim eid As ObjectId = btr.AppendEntity(ent)
                                    tr.AddNewlyCreatedDBObject(ent, True)
                                   
                                    exids.Add(eid)
                                End If
                            Next
                        End If
                        ' define AcadDocument as object
                        Dim ActiveDocument As Object = doc.AcadDocument
                        Dim entids As ObjectId() = New ObjectId() {}
                        Array.Resize(entids, exids.Count)
                        ' convert List<ObjectId> to array of ObjectID
                        exids.CopyTo(entids, 0)

                        ed.Regen()
                        ' create a new selection set and exploded items
                        Dim newset As SelectionSet = SelectionSet.FromObjectIds(entids)

                        ed.SetImpliedSelection(newset.GetObjectIds())

                        Dim pfres As PromptSelectionResult = ed.SelectImplied()
                        ' execute Sendcommand synchronously
                        ActiveDocument.GetType().InvokeMember("SendCommand", System.Reflection.BindingFlags.InvokeMethod, Nothing, ActiveDocument, New Object() {"select" & vbLf})
                        ' execute Sendcommand synchronously
                        Dim cmd As String = "_pedit _M _P" & " " & "" & " " & "_J" & " " & "" & " " & "" & vbLf
                        ActiveDocument.GetType().InvokeMember("SendCommand", System.Reflection.BindingFlags.InvokeMethod, Nothing, ActiveDocument, New Object() {cmd})
                        ' rerase region if this is do not erased (relative to current DELOBJ variable value)
                        If mainReg IsNot Nothing Then
                            If Not mainReg.IsWriteEnabled Then
                                mainReg.UpgradeOpen()
                            End If
                        End If
                        mainReg.Erase()
                       
                        tr.Commit()

                    Catch ex As Autodesk.AutoCAD.Runtime.Exception

                        ed.WriteMessage((vbLf & "AutoCAD exception:" & vbLf + ex.Message & vbLf) + ex.StackTrace)
                    Finally
                        'optional, might be removed
                        ed.WriteMessage(vbLf & "{0}", New Autodesk.AutoCAD.Runtime.ErrorStatus().ToString())
                    End Try
                End Using
            End Using
        End Sub

7
Polylines / Merge polylines using SendCommand C#
« on: April 21, 2013, 01:00:30 PM »
   Here is the basic command to merge / subtract closed contours,
   tested on A2010   
C#
 
Code: [Select]
    [CommandMethod("Rea", CommandFlags.Session)]
        public static void testForUnionPlines()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Editor ed = doc.Editor;
            Database db = doc.Database;
            // get argument to choose boolean operation mode
            PromptKeywordOptions pko = new PromptKeywordOptions("\nChoose boolean operation mode " + "[Union/Subtract]: ", "Union Subtract");
            // The default depends on our current settings
            pko.Keywords.Default = "Union";
            PromptResult pkr = ed.GetKeywords(pko);
            if (pkr.Status != PromptStatus.OK) return;
            string choice = pkr.StringResult;

            bool doUnion = choice == "Union" ? true : false;
            List<Region> regLst = new List<Region>();
            List<Polyline> delPline = new List<Polyline>();
            using (DocumentLock doclock = doc.LockDocument())
            {
                //start a transaction
                using (Transaction tr = db.TransactionManager.StartTransaction())
                {

                    TypedValue[] tvs = new TypedValue[3]
            {new TypedValue(0, "lwpolyline"),
                new TypedValue(-4, "&"),
                new TypedValue(70, 1)
            };
                    SelectionFilter filter = new SelectionFilter(tvs);
                    PromptSelectionOptions pso = new PromptSelectionOptions();
                    pso.MessageForRemoval = "\nSelect closed polylines only: ";
                    pso.MessageForAdding = "\nSelect closed polylines: ";
                    PromptSelectionResult result = ed.GetSelection(filter);
                    if (result.Status != PromptStatus.OK) return;

                    try
                    {
                        SelectionSet sset = result.Value;
                        ObjectId[] ids = sset.GetObjectIds();
                        BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, false);
                        Region objreg1 = new Region();

                        for (int n = 0; n < ids.Count(); n++)
                        {

                            DBObject obj = tr.GetObject(ids[n], OpenMode.ForRead) as DBObject;
                            Polyline pline1 = obj as Polyline;
                            if (pline1 == null) return;
                            // Add the polyline to the List to rerase them all at the end of execution
                            delPline.Add(pline1);
                            // Add the polyline to the array
                            DBObjectCollection objArray1 = new DBObjectCollection();
                            objArray1.Add(pline1);
                            // create the 1 st region
                            DBObjectCollection objRegions1 = new DBObjectCollection();
                            objRegions1 = Region.CreateFromCurves(objArray1);
                            objreg1 = objRegions1[0] as Region;
                            btr.AppendEntity(objreg1);

                            tr.AddNewlyCreatedDBObject(objreg1, true);

                            objreg1.ColorIndex = 1;//optional
                            // add the region to the List<Region> for the future work
                            regLst.Add(objreg1);
                        }
                        //ed.WriteMessage("\nCount regions:\t{0}\n", regLst.Count);//just for the debug

                        // sort regions by areas
                        Region[] items = regLst.ToArray();
                        Array.Sort(items, (Region x, Region y) => y.Area.CompareTo(x.Area));
                        // get the biggest region first
                        Region mainReg = items[0];
                       // ed.WriteMessage("\nMain region area:\t{0:f3}\n", items[0].Area);//just for the debug
                        if (!mainReg.IsWriteEnabled) mainReg.UpgradeOpen();
                        if (items.Length == 2)
                        {

                            if (!doUnion)
                            {
                                mainReg.BooleanOperation(BooleanOperationType.BoolSubtract, (Region)items[1]);
                            }
                            else
                            {
                                mainReg.BooleanOperation(BooleanOperationType.BoolUnite, (Region)items[1]);
                            }
                        }
                        else
                        {
                            // starting iteration from the second region
                            int i = 1;
                            do
                            {
                                Region reg1 = items[i]; Region reg2 = items[i + 1];

                                if ((reg1 == null) || (reg2 == null))
                                {
                                    break;
                                }

                                else
                                {
                                    // subtract region 1 from region 2
                                    if (reg1.Area > reg2.Area)
                                    {
                                        // subtract the smaller region from the larger one
                                        //
                                        reg1.BooleanOperation(BooleanOperationType.BoolUnite, reg2);
                                        if (!doUnion)
                                        {
                                            mainReg.BooleanOperation(BooleanOperationType.BoolSubtract, reg1);
                                        }
                                        else
                                        {
                                            mainReg.BooleanOperation(BooleanOperationType.BoolUnite, reg1);
                                        }

                                    }

                                    else
                                    {

                                        // subtract the smaller region from the larger one

                                        reg2.BooleanOperation(BooleanOperationType.BoolUnite, reg1);
                                        if (!doUnion)
                                        {
                                            mainReg.BooleanOperation(BooleanOperationType.BoolSubtract, reg2);
                                        }
                                        else
                                        {
                                            mainReg.BooleanOperation(BooleanOperationType.BoolUnite, reg2);
                                        }
                                    }

                                }
                                // increase counter
                                i++;
                            } while (i < items.Length - 1);
                        }
                        mainReg.ColorIndex = 1;// put dummy color for region

                        // erase polylines
                        foreach (Polyline poly in delPline)
                        {
                            if (poly != null)
                            {
                                if (!poly.IsWriteEnabled) poly.UpgradeOpen();
                                poly.Erase();
                                if (!poly.IsDisposed) poly.Dispose();
                            }
                        }

                        //  ---    explode region and create polyline from exploded entities   ---   //

                        DBObjectCollection regexpl = new DBObjectCollection();
                        mainReg.Explode(regexpl);

                        List<ObjectId> exids = new List<ObjectId>();

                        // gather selected object into the List<ObjectId>
                        if (regexpl.Count > 0)
                        {
                            foreach (DBObject obj in regexpl)
                            {
                                Entity ent = obj as Entity;
                                if (ent != null)
                                {
                                    ObjectId eid = btr.AppendEntity(ent);
                                    tr.AddNewlyCreatedDBObject(ent, true);
                                   
                                    exids.Add(eid);
                                }
                            }
                        }
                        // define AcadDocument as object
                        object ActiveDocument = doc.AcadDocument;
                        ObjectId[] entids = new ObjectId[] { };
                        Array.Resize(ref entids, exids.Count);
                        // convert List<ObjectId> to array of ObjectID
                        exids.CopyTo(entids, 0);

                        ed.Regen();
                        // create a new selection set and exploded items
                        SelectionSet newset = SelectionSet.FromObjectIds(entids);

                        ed.SetImpliedSelection(newset.GetObjectIds());

                        PromptSelectionResult pfres = ed.SelectImplied();
                        // execute Sendcommand synchronously
                        ActiveDocument.GetType().InvokeMember(
                            "SendCommand", System.Reflection.BindingFlags.InvokeMethod, null, ActiveDocument,
                            new object[] { "select\n" });
                        // execute Sendcommand synchronously
                        string cmd = "_pedit _M _P" + " " + "" + " " + "_J" + " " + "" + " " + "" + "\n";
                        ActiveDocument.GetType().InvokeMember(
                            "SendCommand", System.Reflection.BindingFlags.InvokeMethod, null, ActiveDocument,
                            new object[] { cmd });
                        // rerase region if this is do not erased (relative to current DELOBJ variable value)
                        if (mainReg != null)
                            if (!mainReg.IsWriteEnabled)
                                mainReg.UpgradeOpen();
                        mainReg.Erase();
                       
                        tr.Commit();
                    }

                    catch (Autodesk.AutoCAD.Runtime.Exception ex)
                    {

                        ed.WriteMessage("\nAutoCAD exception:\n" + ex.Message + "\n" + ex.StackTrace);
                    }
                    finally
                    {
                        ed.WriteMessage("\n{0}", new Autodesk.AutoCAD.Runtime.ErrorStatus().ToString());//optional, might be removed
                    }
                }
            }
        }

8
External databases / Draw Polylines using Excel
« on: April 20, 2013, 08:28:38 PM »
Here is complete code, tested on AutoCAD 2010, Excel 2010:
Code: [Select]
Imports System.IO
Imports Microsoft.Office.Interop.Excel
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
'Imports MyProjectName.MyProjectName

<Assembly: CommandClass(GetType(MyProjectName.MyClassName))>
Namespace MyProjectName
    Public Class MyClassName

        <CommandMethod("hex")> _
        Public Sub ExcelToAcad()
            ReadExcelRange("C:\Test\TestXL.xlsx", "Sheet1")'<-- change file name and sheet name here
        End Sub

        Public Sub ReadExcelRange(ByVal xlFileName As String, ByVal xlSheetName As String)
            Dim lstPlines As New List(Of List(Of Object))
            If System.IO.File.Exists(xlFileName) Then

                Dim xlApp As Excel.Application = Nothing
                Dim xlWorkBooks As Excel.Workbooks = Nothing
                Dim xlWorkBook As Excel.Workbook = Nothing
                Dim xlWorkSheet As Excel.Worksheet = Nothing
                Dim xlWorkSheets As Excel.Sheets = Nothing
                Dim xlCells As Excel.Range = Nothing
                Dim xlRange As Excel.Range = Nothing

                xlApp = New Excel.Application
                Try
                    xlApp.DisplayAlerts = False
                    xlWorkBooks = xlApp.Workbooks
                    xlWorkBook = xlWorkBooks.Open(xlFileName)
                    xlApp.Visible = False
                    xlWorkSheets = xlWorkBook.Sheets
                    xlWorkSheet = CType(xlWorkSheets(xlSheetName), Excel.Worksheet)

                    xlRange = CType(xlWorkSheet.UsedRange.CurrentRegion, Excel.Range)


                    Dim xlRow As Excel.Range = Nothing
                    Dim xlCell As Excel.Range = Nothing

                    For irow As Integer = 1 To xlRange.Rows.Count

                        xlRow = CType(xlRange.Rows(irow), Excel.Range)
                        Dim lstRow As New List(Of Object)
                        For icol As Integer = 1 To xlRow.Cells.Count
                            xlCell = CType(xlRange.Cells(irow, icol), Excel.Range)
                            If xlCell.Value IsNot Nothing Then
                                lstRow.Add(xlCell.Value)
                            End If
                        Next

                        lstPlines.Add(lstRow)

                    Next
                    releaseObject(xlCell)
                    releaseObject(xlRow)
                    releaseObject(xlRange)

                    xlWorkBook.Close()

                    xlApp.Quit()

                    releaseObject(xlWorkSheets)
                    releaseObject(xlWorkSheet)
                    releaseObject(xlWorkBook)
                    releaseObject(xlWorkBooks)
                    releaseObject(xlApp)
                Catch ex As System.Exception

                    System.Windows.MessageBox.Show(ex.Message)

                End Try

                If lstPlines.Count > 0 Then
                    Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
                    Dim ed As Editor = doc.Editor
                    Dim db As Database = doc.Database
                    Using tr As Transaction = db.TransactionManager.StartTransaction
                        Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

                        For Each lstCoords As List(Of Object) In lstPlines
                            Dim pline As New Polyline
                            Dim n As Integer = 0
                            Dim i As Integer = 0
                            For n = 0 To lstCoords.Count - 1 Step 2
                                Dim x As Double = Convert.ToDouble(lstCoords(n))
                                Dim y As Double = Convert.ToDouble(lstCoords(n + 1))

                                Dim pp As Point2d = New Point2d(x, y)
                                pline.AddVertexAt(i, pp, 0, 0, 0)
                                i += 1
                            Next
                            btr.AppendEntity(pline)
                            tr.AddNewlyCreatedDBObject(pline, True)
                        Next
                        tr.Commit()
                      System.Windows.MessageBox.Show("See result.")
                    End Using
                End If
            Else
                System.Windows.MessageBox.Show("'" & xlFileName & "' does not found.")
            End If
        End Sub
        Public Sub releaseObject(ByVal obj As Object)
            Try
                System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
                obj = Nothing
            Catch ex As System.Exception
                System.Diagnostics.Debug.Print(ex.ToString())
                obj = Nothing
            Finally
                GC.Collect()
            End Try
        End Sub
End Namespace
Please, see about Excel VB.NET for more :
http://www.siddharthrout.com/tag/vb-net-and-excel/
http://code.msdn.microsoft.com/Basics-of-using-Excel-4453945d
In the attached picture is data used for this code

9
Blocks / Numbering multileader with user block content
« on: March 24, 2013, 10:38:52 PM »
       
In this code used multileader with attributed block "Callout Bubble - Imperial",
after this block is inserted, then deleted, we can create multileader with block "_DetailCallout".
Then we can to number multileader this way:
Code: [Select]
         [CommandMethod("mab")]
        public static void MleaderBlockNumbering()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Editor ed = doc.Editor;
            Database db = doc.Database;

            Transaction tr = db.TransactionManager.StartTransaction();
            try
            {
                using (tr)
                {
                    BlockTable bt = (BlockTable)tr.GetObject(db.BlockTableId, OpenMode.ForRead);
                    BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, false) as BlockTableRecord;
                    string prefix = ""; string suffix = ""; string atag = "SHEETNUMBER";// used "_DetailCallout" block fro Annotation palette
                    int start; int step; bool first = true;
                    ObjectId attnum = ObjectId.Null;
                    PromptStringOptions psto = new PromptStringOptions("\nPrefix: ");
                    psto.AllowSpaces = true;
                    PromptResult res;
                    res = ed.GetString(psto);
                    if (res.Status != PromptStatus.None)
                        prefix = res.StringResult;
                    psto = new PromptStringOptions("\nSuffix: ");
                    psto.AllowSpaces = true;
                    res = ed.GetString(psto);
                    if (res.Status != PromptStatus.None)
                        suffix = res.StringResult;
                    PromptIntegerOptions pio = new PromptIntegerOptions("");
                    pio.Message = "\nStarting number: ";
                    // Restrict input to positive and non-negative values
                    pio.AllowZero = false;
                    pio.AllowNegative = false;
                    pio.DefaultValue = 1;
                    PromptIntegerResult pires = ed.GetInteger(pio);
                    if (pires.Status != PromptStatus.OK) return;
                    start = pires.Value;
                    pio = new PromptIntegerOptions("");
                    pio.Message = "\nIncrement step: ";
                    // Restrict input to positive and non-negative values
                    pio.AllowZero = false;
                    pio.AllowNegative = false;
                    pio.DefaultValue = 1;
                    pires = ed.GetInteger(pio);
                    if (pires.Status != PromptStatus.OK) return;
                    step = pires.Value;
                    doc.TransactionManager.EnableGraphicsFlush(true);
                    //------------------------------------------------------------------------------------------
                    while (true)
                    {
                        PromptSelectionOptions pso = new PromptSelectionOptions();
                        pso.MessageForRemoval = "\nWrong object type or multileader with no block selected";
                        pso.MessageForAdding = "\nSelect multileader with block: ";
                        pso.SingleOnly = true;
                        pso.SinglePickInSpace = true;
                        TypedValue[] tvs = new TypedValue[] {
                new TypedValue((int) DxfCode.Operator, "<AND"),
                new TypedValue((int) DxfCode.Start, "multileader"),
                new TypedValue((int)  DxfCode.Operator, "<NOT"),
                new TypedValue((int)  DxfCode.Operator, "<OR"),
                new TypedValue(296, 0), new TypedValue(296, 1),
                new TypedValue((int)  DxfCode.Operator, "OR>"),
                new TypedValue((int) DxfCode.Operator, "NOT>"),
                new TypedValue((int) DxfCode .Operator, "AND>")
            };

                        SelectionFilter sf = new SelectionFilter(tvs);

                        PromptSelectionResult psr = ed.GetSelection(pso, sf);

                        if (psr.Status != PromptStatus.OK)
                        {
                            ed.WriteMessage("\nWrong selection");
                            break;

                        }

                        Entity ent;
                        ObjectId id = ObjectId.Null;
                        SelectionSet sset = psr.Value;
                        ObjectId[] ids = sset.GetObjectIds();
                        id = ids[0];
                        ent = (Entity)tr.GetObject(id, OpenMode.ForRead, false);
                        MLeader mlead = ent as MLeader;
                        if (mlead == null) return;
                        mlead.UpgradeOpen();
                        if (first)
                        {
                            ObjectId blkid = mlead.BlockContentId;
                            BlockTableRecord mbtr = (BlockTableRecord)tr.GetObject(blkid, OpenMode.ForRead, false) as BlockTableRecord;

                            foreach (ObjectId attid in mbtr)
                            {
                                DBObject obj = tr.GetObject(attid, OpenMode.ForRead);
                                if (obj is AttributeDefinition)
                                {
                                    AttributeDefinition attdef = obj as AttributeDefinition;
                                    if (attdef.Tag == atag)
                                    {
                                        attnum = attdef.ObjectId;
                                        break;
                                    }
                                }
                            }
                            first = false;
                        }
                        AttributeReference attref = mlead.GetBlockAttribute(attnum);
                        attref.TextString = prefix + start.ToString() + suffix;
                        mlead.SetBlockAttribute(attnum, attref);
                        start = start + step;
                        tr.TransactionManager.QueueForGraphicsFlush();
                    }
                    doc.TransactionManager.FlushGraphics();
                    tr.Commit();
                    ed.UpdateScreen();
                }
            }
            catch (Autodesk.AutoCAD.Runtime.Exception ex)
            {
                ed.WriteMessage("\n" + ex.Message + "\n" + ex.StackTrace);
            }
            finally
            {

            }
        }

10
Windows forms / Re: Use dinamically created form in the project
« on: March 23, 2013, 05:26:13 PM »
You're welcome
Cheers :)

11
Selection sets / Move selection to origin
« on: March 17, 2013, 07:39:16 AM »
      C#
   
Code: [Select]
        [System.Security.SuppressUnmanagedCodeSecurity]
        [DllImport("acad.exe", EntryPoint = "acedCmd", CharSet = CharSet.Unicode, CallingConvention = CallingConvention.Cdecl)]
        extern static private int acedCmd(IntPtr resbuf);

        [CommandMethod("moveToOrig, mto", CommandFlags.UsePickSet | CommandFlags.Redraw)]
        static public void testMoveToOrigin()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Editor ed = doc.Editor;
            Database db = doc.Database;
            ResultBuffer rb = new ResultBuffer();
            try
            {

                rb.Add(new TypedValue(5005, "_Zoom"));
                rb.Add(new TypedValue(5005, "_Extents"));
                acedCmd(rb.UnmanagedObject);

                Matrix3d ucs = ed.CurrentUserCoordinateSystem;
                CoordinateSystem3d ccos = ucs.CoordinateSystem3d;
                Point3d orig = ccos.Origin.TransformBy(Matrix3d.Identity);
                // select all objects
                SelectionSet sset = ed.SelectAll().Value;
                if (sset == null) return;
                List<Point3d> pts = new List<Point3d>();
                List<Entity> ents = new List<Entity>();
                Matrix3d mmx = new Matrix3d();
                using (Transaction tr = doc.TransactionManager.StartTransaction())
                {
                    // iterate through selected objects
                    foreach (ObjectId id in sset.GetObjectIds())
                    {

                        Entity ent = (Entity)tr.GetObject(id, OpenMode.ForRead, false);

                        Extents3d ext = ent.GeometricExtents;
                        if (ext != null)
                        {
                            Point3d minpt = ext.MinPoint.TransformBy(Matrix3d.Identity);
                            // collect entities to List for the future work
                            ents.Add(ent);
                            pts.Add(minpt);
                        }
                    }
                    // Get most lower left point of screen
                    Point3d xpt = pts.OrderBy(p => p.X).First();// calculate minimal X value
                    Point3d ypt = pts.OrderBy(p => p.Y).First();// calculate minimal Y value
                 Point3d mp = new Point3d(xpt.X, ypt.Y, orig.Z).TransformBy(Matrix3d.Identity);
                    mmx = Matrix3d.Displacement(orig-mp );
                    // iterate through gathrered entities again
                    foreach (Entity e in ents)
                    {
                        e.UpgradeOpen();
                        // apply transformation matrix
                        e.TransformBy(mmx);
                    }

                    tr.Commit();
                }
            }
            catch (Autodesk.AutoCAD.Runtime.Exception ex)
            {
                ed.WriteMessage("\n" + ex.Message + "\n" + ex.StackTrace);
            }
            finally
            {
                rb = new ResultBuffer();
                rb.Add(new TypedValue(5005, "_Zoom"));
                rb.Add(new TypedValue(5005, "_Extents"));
                acedCmd(rb.UnmanagedObject);
            }
        }
      VB.NET

      
Code: [Select]
<System.Security.SuppressUnmanagedCodeSecurity> _
<DllImport("acad.exe", EntryPoint := "acedCmd", CharSet := CharSet.Unicode, CallingConvention := CallingConvention.Cdecl)> _
Private Shared Function acedCmd(resbuf As IntPtr) As Integer
End Function

<CommandMethod("moveToOrig, mto", CommandFlags.UsePickSet Or CommandFlags.Redraw)> _
Public Shared Sub testMoveToOrigin()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Dim rb As New ResultBuffer()
Try

rb.Add(New TypedValue(5005, "_Zoom"))
rb.Add(New TypedValue(5005, "_Extents"))
acedCmd(rb.UnmanagedObject)

Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem
Dim ccos As CoordinateSystem3d = ucs.CoordinateSystem3d
Dim orig As Point3d = ccos.Origin.TransformBy(Matrix3d.Identity)
' select all objects
Dim sset As SelectionSet = ed.SelectAll().Value
If sset Is Nothing Then
Return
End If
Dim pts As New List(Of Point3d)()
Dim ents As New List(Of Entity)()
Dim mmx As New Matrix3d()
Using tr As Transaction = doc.TransactionManager.StartTransaction()
' iterate through selected objects
For Each id As ObjectId In sset.GetObjectIds()

Dim ent As Entity = DirectCast(tr.GetObject(id, OpenMode.ForRead, False), Entity)

Dim ext As Extents3d = ent.GeometricExtents
If ext IsNot Nothing Then
Dim minpt As Point3d = ext.MinPoint.TransformBy(Matrix3d.Identity)
' collect entities to List for the future work
ents.Add(ent)
pts.Add(minpt)
End If
Next
' Get most lower left point of screen
Dim xpt As Point3d = pts.OrderBy(Function(p) p.X).First()
' calculate minimal X value
Dim ypt As Point3d = pts.OrderBy(Function(p) p.Y).First()
' calculate minimal Y value
Dim mp As Point3d = New Point3d(xpt.X, ypt.Y, orig.Z).TransformBy(Matrix3d.Identity)
mmx = Matrix3d.Displacement(orig - mp)
' iterate through gathrered entities again
For Each e As Entity In ents
e.UpgradeOpen()
' apply transformation matrix
e.TransformBy(mmx)
Next

tr.Commit()
End Using
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage((vbLf + ex.Message & vbLf) + ex.StackTrace)
Finally
rb = New ResultBuffer()
rb.Add(New TypedValue(5005, "_Zoom"))
rb.Add(New TypedValue(5005, "_Extents"))
acedCmd(rb.UnmanagedObject)
End Try
End Sub

12
Dimensions / Re: Some basic dimensions function
« on: March 16, 2013, 06:54:40 AM »
Ok, will be glad to see your final solution,
Kind regards,
Oleg

13
Blocks / Change text object in block reference
« on: March 15, 2013, 04:57:16 PM »
   C#
Code: [Select]
     
        // Change the text object in the BlockTableRecord by selecting them on screen
        // This method may have any name
        [CommandMethod("cato", CommandFlags.UsePickSet | CommandFlags.Redraw)]
        public static void ChangeTextInBlockDef()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;

            Database db = doc.Database;

            Editor ed = doc.Editor;

            Transaction tr = db.TransactionManager.StartTransaction();
            using (tr)
            {
                doc.TransactionManager.EnableGraphicsFlush(true);
                PromptNestedEntityOptions pno = new PromptNestedEntityOptions("\nSelect text within block instance: ");
                pno.AllowNone = true;
                pno.UseNonInteractivePickPoint = false;
                PromptNestedEntityResult rs = ed.GetNestedEntity(pno);
                if (rs.Status != PromptStatus.OK) return;
                Entity selent = (Entity)tr.GetObject(rs.ObjectId, OpenMode.ForRead);
                ed.WriteMessage("\nSelected type of {0}", selent.GetType().Name);

                PromptStringOptions pso = new PromptStringOptions("\nEnter new text: ");
                pso.AllowSpaces = true;
                PromptResult res;
                res = ed.GetString(pso);
                if (res.Status != PromptStatus.OK) return;
                string newstr = res.StringResult;
                ed.WriteMessage("\nNew Text Entered:\t{0}", newstr);

                BlockTableRecord btrec = tr.GetObject(selent.OwnerId, OpenMode.ForWrite) as BlockTableRecord;
                // prevent work with attributes and embedded blocks
                if (selent.ObjectId.ObjectClass.IsDerivedFrom(RXClass.GetClass(typeof(AttributeReference))) |
                    selent.ObjectId.ObjectClass.IsDerivedFrom(RXClass.GetClass(typeof(BlockReference)))) return;
                if (selent.ObjectId.ObjectClass.IsDerivedFrom(RXClass.GetClass(typeof(DBText))))
                {
                    DBText txt = selent as DBText;
                    string oldstr = txt.TextString;

                    BlockTableRecord owner = (BlockTableRecord)tr.GetObject(txt.OwnerId, OpenMode.ForRead);
                    ed.WriteMessage("\nName:\t{0}", owner.Name);
                    owner.UpgradeOpen();
                    foreach (ObjectId id in owner)
                    {
                        if (!id.ObjectClass.IsDerivedFrom(RXClass.GetClass(typeof(DBText)))) continue;
                        DBObject obj = tr.GetObject(id, OpenMode.ForRead);
                        DBText blktxt = obj as DBText;
                        if (blktxt.TextString != oldstr) continue;
                        blktxt.UpgradeOpen();
                        blktxt.TextString = newstr;

                    }

                    //--------------------------------------------------------------
                    // add other possible types such as mtext, dimension etc here
                    //--------------------------------------------------------------


                    tr.TransactionManager.QueueForGraphicsFlush();

                    doc.TransactionManager.FlushGraphics();

                    tr.Commit();

                    ed.Regen();
                }
            }
        }
   VB.NET
Code: [Select]
        ' Change the text object in the BlockTableRecord by selecting them on screen
        ' This method may have any name
        <CommandMethod("cato", CommandFlags.UsePickSet Or CommandFlags.Redraw)> _
        Public Shared Sub ChangeTextInBlockDef()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim db As Database = doc.Database

            Dim ed As Editor = doc.Editor

            Dim tr As Transaction = db.TransactionManager.StartTransaction()
            Using tr
                doc.TransactionManager.EnableGraphicsFlush(True)
                Dim pno As New PromptNestedEntityOptions(vbLf & "Select text within block instance: ")
                pno.AllowNone = True
                pno.UseNonInteractivePickPoint = False
                Dim rs As PromptNestedEntityResult = ed.GetNestedEntity(pno)
                If rs.Status <> PromptStatus.OK Then
                    Return
                End If
                Dim selent As Entity = DirectCast(tr.GetObject(rs.ObjectId, OpenMode.ForRead), Entity)
                ed.WriteMessage(vbLf & "Selected type of {0}", selent.[GetType]().Name)

                Dim pso As New PromptStringOptions(vbLf & "Enter new text: ")
                pso.AllowSpaces = True
                Dim res As PromptResult
                res = ed.GetString(pso)
                If res.Status <> PromptStatus.OK Then
                    Return
                End If
                Dim newstr As String = res.StringResult
                ed.WriteMessage(vbLf & "New Text Entered:" & vbTab & "{0}", newstr)

                Dim btrec As BlockTableRecord = TryCast(tr.GetObject(selent.OwnerId, OpenMode.ForWrite), BlockTableRecord)
                ' prevent work with attributes and embedded blocks
                If selent.ObjectId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(AttributeReference))) Or selent.ObjectId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(BlockReference))) Then
                    Return
                End If
                If selent.ObjectId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(DBText))) Then
                    Dim txt As DBText = TryCast(selent, DBText)
                    Dim oldstr As String = txt.TextString

                    Dim owner As BlockTableRecord = DirectCast(tr.GetObject(txt.OwnerId, OpenMode.ForRead), BlockTableRecord)
                    ed.WriteMessage(vbLf & "Name:" & vbTab & "{0}", owner.Name)
                    owner.UpgradeOpen()
                    For Each id As ObjectId In owner
                        If Not id.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(DBText))) Then
                            Continue For
                        End If
                        Dim obj As DBObject = tr.GetObject(id, OpenMode.ForRead)
                        Dim blktxt As DBText = TryCast(obj, DBText)
                        If blktxt.TextString <> oldstr Then
                            Continue For
                        End If
                        blktxt.UpgradeOpen()

                        blktxt.TextString = newstr
                    Next

                    '--------------------------------------------------------------
                    ' add other possible types such as mtext, dimension etc here
                    '--------------------------------------------------------------


                    tr.TransactionManager.QueueForGraphicsFlush()

                    doc.TransactionManager.FlushGraphics()

                    tr.Commit()

                    ed.Regen()
                End If
            End Using
        End Sub

14
Dimensions / Re: Some basic dimensions function
« on: March 14, 2013, 03:50:40 PM »
Can you upload small picture (.png or .jpg) to see what
you exacrly need?

15
Text / Place Text to center using calculated text width
« on: March 12, 2013, 05:52:23 PM »
   C# 
       
Code: [Select]
   
       // Place Text to center using calculated text width
        // tested on A2010 .NET Framework 3.5
        [CommandMethod("tcenter")]
        public static void textToCenter()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Database db = doc.Database;
            Autodesk.AutoCAD.GraphicsInterface.TextStyle style = new Autodesk.AutoCAD.GraphicsInterface.TextStyle();
            byte n;

            Transaction tr = db.TransactionManager.StartTransaction();
            try
            {
                using (tr)
                {
                    BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite);
                    // setup the text
                    string text = "1234567890";
                    // add new dbtext to current space
                    DBText txt = new DBText();
                    txt.SetDatabaseDefaults();
                    txt.TextString = text;
                    txt.Position = new Point3d(100, 200, 0);
                    btr.AppendEntity(txt);
                    tr.AddNewlyCreatedDBObject(txt, true);
                    // get textstyle of newly created text
                    TextStyleTableRecord txtbtr = (TextStyleTableRecord)tr.GetObject(txt.TextStyleId, OpenMode.ForRead);
                    // copy properties from TextStyleTableRecord and dbtext to temp AcGi.TextStyle (just very limited one for the future calculation)
                    style.FileName = txtbtr.FileName;
                    // then copy properties from existing text
                    style.TextSize = txt.Height;  // txtbtr.TextSize;
                    style.ObliquingAngle = txt.Oblique;
                    style.XScale = txt.WidthFactor;
                    // load temp style record
                    try
                    {
                        n = style.LoadStyleRec;
                    }
                    catch { return; }// something wrong then exit on error

                    // set new position of text center, i.e. some dummy point
                    Point3d cpt = new Point3d(20, -45, 0);

                    // find out the extents
                    Point2d minpt, maxpt;
                    // get extends of text
                    Extents2d ex = style.ExtentsBox(text, true, true, null);

                    minpt = ex.MinPoint;
                    maxpt = ex.MaxPoint;
                    // work out the insertion point
                    Point3d newpos = cpt - new Vector3d((minpt.X + maxpt.X) / 2.0, (minpt.Y + maxpt.Y) / 2.0, 0);
                    // change text position to be centered in this point, independently of text alignment mode
                    txt.Position = newpos;
                    style.Dispose();// it's not a database resident, so dispose style, optional
                    tr.Commit();
                }
            }
            catch (System.Exception exc)
            {
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(exc.Message + "\n" + exc.StackTrace);
            }
            finally { }
        }
   VB.NET

Code: [Select]
      ' Place Text to center using calculated text width
        ' tested on A2010 .NET Framework 3.5
        <CommandMethod("tcenter")> _
        Public Shared Sub textToCenter()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim style As New Autodesk.AutoCAD.GraphicsInterface.TextStyle()
            Dim n As Byte

            Dim tr As Transaction = db.TransactionManager.StartTransaction()
            Try
                Using tr
                    Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                    ' setup the text
                    Dim text As String = "1234567890"
                    ' add new dbtext to current space
                    Dim txt As New DBText()
                    txt.SetDatabaseDefaults()
                    txt.TextString = text
                    txt.Position = New Point3d(100, 200, 0)
                    btr.AppendEntity(txt)
                    tr.AddNewlyCreatedDBObject(txt, True)
                    ' get textstyle of newly created text
                    Dim txtbtr As TextStyleTableRecord = DirectCast(tr.GetObject(txt.TextStyleId, OpenMode.ForRead), TextStyleTableRecord)
                    ' copy properties from TextStyleTableRecord and dbtext to temp AcGi.TextStyle (just very limited one for the future calculation)
                    style.FileName = txtbtr.FileName
                    ' then copy properties from existing text
                    style.TextSize = txt.Height
                    ' txtbtr.TextSize;
                    style.ObliquingAngle = txt.Oblique
                    style.XScale = txt.WidthFactor
                    ' load temp style record
                    Try
                        n = style.LoadStyleRec
                    Catch
                        Return
                    End Try
                    ' something wrong then exit on error
                    ' set new position of text center, i.e. some dummy point
                    Dim cpt As New Point3d(20, -45, 0)

                    ' find out the extents
                    Dim minpt As Point2d, maxpt As Point2d
                    ' get extends of text
                    Dim ex As Extents2d = style.ExtentsBox(text, True, True, Nothing)

                    minpt = ex.MinPoint
                    maxpt = ex.MaxPoint
                    ' work out the insertion point
                    Dim newpos As Point3d = cpt - New Vector3d((minpt.X + maxpt.X) / 2.0, (minpt.Y + maxpt.Y) / 2.0, 0)
                    ' change text position to be centered in this point, independently of text alignment mode
                    txt.Position = newpos
                    style.Dispose()
                    ' it's not a database resident, so dispose style, optional
                    tr.Commit()
                End Using
            Catch exc As System.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(exc.Message & vbLf & exc.StackTrace)
            Finally
            End Try
        End Sub

Pages: [1] 2 3 ... 9