Recent Posts

Pages: 1 2 3 [4] 5 6 ... 10
31
Layouts and printing / Rename layouts custom way
« Last post by fixo on May 19, 2013, 02:37:37 PM »
   
Code: [Select]
VB.NET
        'Public Class LayoutTools

        ' declare layout names outside of method, keep them empty:
        Private oldname As String = ""
        Private newname As String = ""
        <CommandMethod("lre")> _
        Public Sub testLayoutsRename()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Dim ed As Editor = doc.Editor
            Dim tr As Transaction = db.TransactionManager.StartTransaction()

            Dim ltnames As New SortedList(Of String, String)()
           ' lst of pairs <old layout name,new layout name>: '
            ltnames.Add("Layout1", "General")
            ltnames.Add("Layout2", "Floor Plan 1")
            ltnames.Add("Layout3", "Floor Plan 2")
            ltnames.Add("Layout4", "Floor Plan 3")
            '   ETC ...
            Dim lm As LayoutManager = LayoutManager.Current
            Dim lyid As ObjectId = ObjectId.Null
            Try
                Using tr
                    For Each kvp As KeyValuePair(Of String, String) In ltnames
                        oldname = kvp.Key
                        newname = kvp.Value
                        lyid = lm.GetLayoutId(oldname)

                        If lm.GetLayoutId(oldname) <> ObjectId.Null Then
                            Dim lt As Layout = TryCast(tr.GetObject(lyid, OpenMode.ForWrite), Layout)

                            AddHandler lm.LayoutRenamed, AddressOf lm_LayoutRenamed
                            AddHandler lm.LayoutToBeRenamed, AddressOf lm_LayoutToBeRenamed
                            lt.LayoutName = newname
                        End If
                    Next
                    tr.Commit()
                    ed.Regen()
                End Using
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "Error Reason: {0}" & vbLf, ex.ErrorStatus)
                Return
            End Try

        End Sub

        Private Sub lm_LayoutRenamed(sender As Object, e As LayoutRenamedEventArgs)
            Dim newmame As String = ""
            Try
                newmame = e.NewName
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "Invalid layout name: {0}" & vbLf & "{1}", e.NewName, ex.ErrorStatus)
                Return
            End Try

        End Sub
        Private Sub lm_LayoutToBeRenamed(sender As Object, e As LayoutRenamedEventArgs)
            Try
                SymbolUtilityServices.ValidateSymbolName(oldname, False)
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "Invalid layout name: {0}" & vbLf & "{1}", e.NewName, ex.ErrorStatus)
                Return
            End Try

        End Sub

        ' End Class 'end of class

   C#

   
Code: [Select]
        // public class LayoutTools
        // {
        // declare layout names outside of method, keep them empty:
        string oldname = ""; string newname = "";
        [CommandMethod("lre")]
        public void testLayoutsRename()
        {
            Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
            Database db = HostApplicationServices.WorkingDatabase;
            Editor ed = doc.Editor;
            Transaction tr = db.TransactionManager.StartTransaction();

            SortedList<string, string> ltnames = new SortedList<string, string>();
           // lst of pairs <old layout name,new layout name>: //
            ltnames.Add("Layout1", "General");
            ltnames.Add("Layout2", "Floor Plan 1");
            ltnames.Add("Layout3", "Floor Plan 2");
            ltnames.Add("Layout4", "Floor Plan 3");//   ETC ...
            LayoutManager lm = LayoutManager.Current;
            ObjectId lyid = ObjectId.Null;
            try
            {
                using (tr)
                {
                    foreach (KeyValuePair<string, string> kvp in ltnames)
                    {
                        oldname = kvp.Key; newname = kvp.Value;
                        lyid = lm.GetLayoutId(oldname);

                        if (lm.GetLayoutId(oldname) != ObjectId.Null)
                        {
                            Layout lt = tr.GetObject(lyid, OpenMode.ForWrite) as Layout;

                            lm.LayoutRenamed += new LayoutRenamedEventHandler(lm_LayoutRenamed);
                            lm.LayoutToBeRenamed += new LayoutRenamedEventHandler(lm_LayoutToBeRenamed);
                            lt.LayoutName = newname;
                        }
                    }
                    tr.Commit();
                    ed.Regen();
                }
            }
            catch (Autodesk.AutoCAD.Runtime.Exception ex)
            {
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(
                    "\nRerror Reason: {0}\n", ex.ErrorStatus);
                return;
            }

        }

        private void lm_LayoutRenamed(object sender, LayoutRenamedEventArgs e)
        {
            string newmame = "";
            try
            {
                newmame = e.NewName;
            }
            catch (Autodesk.AutoCAD.Runtime.Exception ex)
            {
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(
                    "\nInvalid layout name: {0}\n{1}", e.NewName, ex.ErrorStatus);
                return;
            }

        }
        private void lm_LayoutToBeRenamed(object sender, LayoutRenamedEventArgs e)
        {
            try
            {
                SymbolUtilityServices.ValidateSymbolName(oldname, false);
            }
            catch (Autodesk.AutoCAD.Runtime.Exception ex)
            {
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(
                    "\nInvalid layout name: {0}\n{1}", e.NewName, ex.ErrorStatus);
                return;
            }

        }

    //}// end of class
 
32
Text / Change the background mask property of AcDbMText object programmatically
« Last post by fixo on May 18, 2013, 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();
            }
        }
33
This site / Re: Welcome on the AutoCAD .NET developpers forums
« Last post by thuannguyen on May 16, 2013, 01:01:21 PM »
Hi, My mane's ThuanNguyen. Nice to meet all!
34
Dimensions / Re: Some basic dimensions function
« Last post by dockee on May 13, 2013, 05:17:16 PM »
This is the solution to put an isométric dim as this picture.




Code: [Select]
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common


Public Class Main

' Programme de cotation isomètrique
' mai 2013 REV 1.0
' Auteur : F. LEGAY


#Region "programme principal"

<CommandMethod("COTISO")> _
Sub Main()

' Déclaration des variables
Dim OldLayer = Application.GetSystemVariable("clayer")
Dim OldOrtho = Application.GetSystemVariable("orthomode")
Dim OldSnap = Application.GetSystemVariable("snapmode")
Dim CotAng As Double
Dim plan As Integer = Application.GetSystemVariable("snapisopair")
Dim dimStyleName As String = "iso8-30"
Dim Doc As Document = Application.DocumentManager.MdiActiveDocument
Dim Db As Database = HostApplicationServices.WorkingDatabase
Dim Ed As Editor = Doc.Editor

' Activation de la couche pour dessinner les cotations
Application.SetSystemVariable("clayer", "10 - COTATION")

' Demande le premier point
Dim Pt1 As New Point3d
Dim Opt1 As New PromptPointOptions(vbLf & "Entrer le premier point")
Dim Res1 As PromptPointResult = Ed.GetPoint(Opt1)

If Res1.Status = PromptStatus.OK Then
Pt1 = Res1.Value
End If

' Demande le deuxième point
Dim Pt2 As New Point3d
Dim Opt2 As New PromptPointOptions(vbLf & "Entrer le deuxième point")
Dim Res2 As PromptPointResult = Ed.GetPoint(Opt2)

If Res2.Status = PromptStatus.OK Then
Pt2 = Res2.Value
End If

Dim ang As Double = AngleFromXAxis(Pt1, Pt2)
Dim angdeg As String = CType((180 * ang / Math.PI), String)

' Demande la position de la ligne de cote
Dim Pt3 As New Point3d
Dim Opt3 As New PromptPointOptions(vbLf & "Entrer la position de la ligne de cote")
Dim Res3 As PromptPointResult = Ed.GetPoint(Opt3)

If Res3.Status = PromptStatus.OK Then
Pt3 = Res3.Value
End If

' Demande la position de la ligne de cote
Dim DimStr As String = ""
Dim StrOpt As New PromptStringOptions(vbLf & "Entrer la valeur de la cotation")
Dim ResStr As PromptResult = Ed.GetString(StrOpt)

If ResStr.Status = PromptStatus.OK Then
DimStr = ResStr.StringResult
End If

'Détermine le style de cotation en cours
Using Tr As Transaction = Db.TransactionManager.StartTransaction

Dim DimTbl As DimStyleTable = CType(Tr.GetObject(Db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If DimTbl.Has(dimStyleName) Then
Dim DimRecord As DimStyleTableRecord = CType(Tr.GetObject(DimTbl(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
If DimRecord.ObjectId <> Db.Dimstyle Then
Db.Dimstyle = DimRecord.ObjectId
Db.SetDimstyleData(DimRecord)
End If
End If
Tr.Commit()

End Using

' Définit l'angle et de style de cotation a utiliser
Select Case angdeg
Case "90"
Select Case plan
Case 0
dimStyleName = "iso830"
CotAng = CType((Math.PI * 240 / 180.0), Double)
Case 2
dimStyleName = "iso8-30"
CotAng = CType((Math.PI * 120 / 180.0), Double)
End Select
Case "270"
Select Case plan
Case 0
dimStyleName = "iso830"
CotAng = CType((Math.PI * 240 / 180.0), Double)
Case 2
dimStyleName = "iso8-30"
CotAng = CType((Math.PI * 120 / 180.0), Double)
End Select
Case "330"
Select Case plan
Case 0
dimStyleName = "iso8-30"
CotAng = CType((Math.PI * 120 / 180.0), Double)
Case 1
dimStyleName = "iso830"
CotAng = CType((Math.PI * 240 / 180.0), Double)
End Select
Case "150"
Select Case plan
Case 0
dimStyleName = "iso8-30"
CotAng = CType((Math.PI * 120 / 180.0), Double)
Case 1
dimStyleName = "iso830"
CotAng = CType((Math.PI * 240 / 180.0), Double)
End Select
Case "30"
Select Case plan
Case 1
dimStyleName = "iso8-30"
CotAng = CType((Math.PI * 120 / 180.0), Double)
Case 2
dimStyleName = "iso830"
CotAng = CType((Math.PI * 240 / 180.0), Double)
End Select
Case "210"
Select Case plan
Case 1
dimStyleName = "iso8-30"
CotAng = CType((Math.PI * 120 / 180.0), Double)
Case 2
dimStyleName = "iso830"
CotAng = CType((Math.PI * 240 / 180.0), Double)
End Select
End Select


' Création de la cotation
Using Tr As Transaction = Db.TransactionManager.StartTransaction

Dim btr As BlockTableRecord = CType(Tr.GetObject(Db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(Tr.GetObject(Db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(Tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)

Dim odim As AlignedDimension = New AlignedDimension(Pt1, Pt2, Pt3, DimStr, dtr.ObjectId)
odim.SetDatabaseDefaults()
odim.Oblique = CotAng
btr.AppendEntity(odim)
Tr.AddNewlyCreatedDBObject(odim, True)

Tr.Commit()

End Using

'Application.SetSystemVariable("snapstyl", 1)
Application.SetSystemVariable("clayer", OldLayer)



  End Sub


  Public Function AngleFromXAxis(ByVal p1 As Point3d, ByVal p2 As Point3d) As Double

    Return New Vector2d(p2.X - p1.X, p2.Y - p1.Y).Angle

  End Function


#End Region


End Class

Sorry if it too long that put my code.
35
Layers / Create new layer by selecting a single object
« Last post by fixo 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
36
Selection sets / Count total length using LINQ
« Last post by fixo 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
37
3D entities / Loop for calculation of random lines on a 3dcube
« Last post by surfer96 on May 02, 2013, 07:01:16 PM »
Hi all,
I'm trying to generate a "grid" of randomly generated 3dlines on the surface of a 3dcube.
Any of the single areas on the cube's surface shall be within a certain range, eg between 1 and 5 m².
In case one or more of the areas shall be outside the wanted range (1 to 5 m²), the generation of the 3dlines shall be sent back to a loop, where a new set of 3dlines will be regenerated. And so on and so on until the loop's result is matching the geometric constraints.
Can this be achieved by acad.net? The random-lines and the conditional loop should be no problem, but what about the calculation of each of the single areas on the surface?
Here are some ideas for calculating the areas, although I do not exactly know whether they will work or not:
In AutoCAD one could break up all the lines at their reciprocal intersection points (But how can this be done?). The result would be a set of collinear yet seperate line objects which could be converted into regions bearing their area as property. The AutoCAD regions' areas could then be sent to the conditional loop.
Or, instead of an area, the conditional statement for the loop could be a minimum distance between all the intersection points of the 3dlines. So one would have a set of let's say 100 points, and each of these points would have to be tested whether being in a certain distance intervall to the closest of the 99 other points.
Does anyone have an idea, if this can be solved in acad.net returning the wanted random-grid to AutoCAD???
By the way I tried all this in Rhino supported by Grasshopper and Hoopsnake. It worked, but the calculation (requiring thousands or even millions of iterations) was VERY MUCH too slow. So I hope that acad.net might be a faster alternative for this kind of random based design approach.
Thanks for your help in advance.
38
Polylines / Creates a rectangle from the mid points of opposing sides
« Last post by fixo 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
39
This site / devlopers guide pdf
« Last post by tuksy on April 25, 2013, 04:29:23 PM »
bonjour a tous , je suis nouveau dans la programation sous autocad et j'aimerais bien avoir "autocad devloper's guide " en pdf marci de me guidé car j'ai mare de lire sur un écran
40
Blocks / Insert block with attributes by predefined values
« Last post by fixo 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
Pages: 1 2 3 [4] 5 6 ... 10