how can I add a menu in my autocad ?

[Anonymous]

hello everbody, I have a question.

when I use the autolisp , I used  a code like this;

(initget "ODA SALON MUTFAK BANYO ANTRE")
(setq mahal_ismi (getkword "n[ODA/SALON/MUTFAK/BANYO/ANTRE]: "))

 but now I want to use vb.net

may I make like this on vb.net ?

[Hallex · Accepted solution]

See quick example:

       <CommandMethod("kwords")> _
        Public Sub testKeyWords()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            Dim pko As New PromptKeywordOptions(vbLf & "Choose item [ODA/SALON/MUTFAK/BANYO/ANTRE]: ", "ODA SALON MUTFAK BANYO ANTRE")
            ' The default depends on our current settings
            pko.Keywords.Default = "ODA"
            Dim pres As PromptResult = ed.GetKeywords(pko)
            If pres.Status <> PromptStatus.OK Then Return

            Dim choice As String = pres.StringResult
            Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Choosen: " + choice)
        End Sub

[Anonymous]

it is works. thank you 🙂

[Anonymous]

actually I have one more question.

after choose my menu, I would like to add a circle.

is this possible or not?

how can I do this ?

 

 pPtOpts.Message = vbLf & "Enter the center of circle: "
            pPtRes = acDoc.Editor.GetPoint(pPtOpts)
            Dim ptStart As Point3d = pPtRes.Value

[Hallex]

Here is example borrowed from web,

change to your suit :

       Function getClass(ByVal myClassName As String)
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim prStrOpts As New PromptStringOptions("Class Name <" + myClassName + ">")
            Dim prResult As PromptResult
            prStrOpts.AllowSpaces = True
            prStrOpts.AppendKeywordsToMessage = True
            prResult = ed.GetString(prStrOpts)
            If prResult.Status = PromptStatus.OK Then
                If prResult.StringResult.Equals("") Then
                    Return myClassName
                Else
                    Return prResult.StringResult
                End If
            Else
                Return myClassName
            End If
        End Function

        'Puts the text values into ACAD as MTEXT
        Sub putClassMText(ByVal loc As Point3d, ByVal myClassName As String, _
        ByVal myInstructor As String, ByVal myHrs As Double)
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Dim myT As Transaction =  HostApplicationServices.WorkingDatabase().TransactionManager.StartTransaction()
            Try
                'Open the block table in order to access the ModelSpace
                'bt receives the BlockTable Object using the transaction manager
                Dim bt As BlockTable = _
                CType(myT.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
                'Open the modelspace for write
                'btr receives the ModelSpace Object using the transaction manager
                Dim btr As BlockTableRecord = _
                CType(myT.GetObject(bt(BlockTableRecord.ModelSpace), _
                OpenMode.ForWrite, False), BlockTableRecord)
                Dim mtext As New MText 'This is the Mtext that is added to ModelSpace
                'mtext.Contents = "Class: " + myClassName + vbLf + _
                '"Instructor: " + myInstructor + vbLf + _
                '[String].Format("Hours=: {0:#.##}", myHrs)
                mtext.Contents = goDialog(myClassName, myInstructor, myHrs)
                mtext.Location = loc 'Point3D
                'Add the MText to the btr Object
                btr.AppendEntity(mtext)
                'Inform the transaction manager of the addition
                myT.AddNewlyCreatedDBObject(mtext, True)
                'Commit the transaction
                myT.Commit()
            Catch ex As Exception
                'Error catching is not really necessary since we will dispose
                'of the transaction in the finally block.
                MsgBox(Err.Description)
            Finally
                'We are finished using this transaction
                myT.Dispose()
            End Try
        End Sub

        'Displays a dialog to retrieve the values
        Function goDialog(ByRef myClassName As String, ByVal myInstructor As String, ByRef myHrs As Double) As String
            'Dim dlgLoopy As New dlgLoopy
            Dim sb As New StringBuilder
            'dlgLoopy.TextBox1.Text = myClassName
            'dlgLoopy.TextBox2.Text = myInstructor
            'dlgLoopy.ComboBox1.Text = String.Format("{0:#.##}", myHrs)
            sb.AppendLine(myClassName)
            sb.AppendLine(myInstructor)
            sb.AppendLine(String.Format("{0:#.##}", myHrs))
            'Show dialog as modal (xxx.Show() is non-modal)
            'Application.ShowModalDialog(dlgLoopy)
            'If dlgLoopy.DialogResult = Windows.Forms.DialogResult.OK Then
            '    myClassName = dlgLoopy.TextBox1.Text
            '    myInstructor = dlgLoopy.TextBox2.Text
            '    myHrs = CDbl(dlgLoopy.ComboBox1.Text)
            'End If
            'dlgLoopy.Dispose()
            Return sb.ToString
        End Function
        <CommandMethod("gof")> _
        Public Sub LoopPointsExample()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim db As Database = doc.Database
            'Establish default values
            Dim strClassName As New String("Going Loopy")
            Dim strInstructor As New String("Doug Goforth")
            Dim dblHours As New Double
            dblHours = 1.5
            Dim keepLooping As Boolean = True
            'Start the command loop
            While keepLooping
                Try

                    Dim pto As PromptPointOptions = New PromptPointOptions(vbLf + "Pick point or: ")
                    'Establish the valid keywords for the prompt
                    pto.Keywords.Add("Dialog")
                    pto.Keywords.Add("Class")
                    pto.Keywords.Add("Instructor")
                    pto.Keywords.Add("Hours")
                    pto.Keywords.Add("Quit")
                    pto.Keywords.Add("?")
                    pto.AllowNone = True 'Allow user to just press ENTER
                    pto.AppendKeywordsToMessage = True
                    Dim res As PromptPointResult
                    'Display the prompt (use GetPoint when expecting a point or keyword)
                    res = ed.GetPoint(pto)
                    'Respond to the possible prompt results...
                    Select Case res.Status
                        Case PromptStatus.OK
                            'Point was provided
                            putClassMText(res.Value, strClassName, strInstructor, dblHours)
                        Case PromptStatus.Keyword
                            'User responded with one of the valid keywords
                            'established in the PromptPointOptions
                            Select Case res.StringResult
                                Case "Dialog"
                                    goDialog(strClassName, strInstructor, dblHours)
                                    keepLooping = True
                                Case "Hours"
                                    dblHours = dblHours 'getHours(dblHours)
                                    keepLooping = True
                                Case "Instructor"
                                    strInstructor = strInstructor 'getInstructor(strInstructor)
                                    keepLooping = True
                                Case "Class"
                                    strClassName = getClass(strClassName)
                                    keepLooping = True
                                Case "?"
                                    ed.WriteMessage(vbLf + " Class: " + strClassName)
                                    ed.WriteMessage(vbLf + " Instructor: " + strInstructor)
                                    ed.WriteMessage(vbLf + " " + [String].Format("Hours: {0:#.##}", dblHours))
                                    keepLooping = True
                                Case "Quit"
                                    keepLooping = False
                                Case Else
                                    keepLooping = False
                            End Select
                        Case PromptStatus.Cancel
                            'User pressed escape
                            keepLooping = False
                        Case PromptStatus.None
                            'User pressed ENTER
                            keepLooping = False
                        Case Else 'Other erroneous input
                            keepLooping = True
                    End Select
                Catch ex As Exception 'Catch the error to continue processing
                    'Should not happen if all the possible
                    'return values from the prompt are handled
                    MsgBox(Err.Description)
                End Try
            End While
        End Sub

[Anonymous]

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors
 
<CommandMethod("CreateAndAssignALayer")> _
Public Sub CreateAndAssignALayer()
  '' Get the current document and database
  Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
  Dim acCurDb As Database = acDoc.Database
 
  '' Start a transaction
  Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
 
      '' Open the Layer table for read
      Dim acLyrTbl As LayerTable
      acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, _
                                   OpenMode.ForRead)
 
      Dim sLayerName As String = "Center"
 
      If acLyrTbl.Has(sLayerName) = False Then
          Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()
 
          '' Assign the layer the ACI color 1 and a name
          acLyrTblRec.Color = Color.FromColorIndex(ColorMethod.ByAci, 1)
          acLyrTblRec.Name = sLayerName
 
          '' Upgrade the Layer table for write
          acLyrTbl.UpgradeOpen()
 
          '' Append the new layer to the Layer table and the transaction
          acLyrTbl.Add(acLyrTblRec)
          acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
      End If
 
      '' Open the Block table for read
      Dim acBlkTbl As BlockTable
      acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, _
                                   OpenMode.ForRead)
 
      '' Open the Block table record Model space for write
      Dim acBlkTblRec As BlockTableRecord
      acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
                                      OpenMode.ForWrite)
 
      '' Create a circle object
      Dim acCirc As Circle = New Circle()
      acCirc.Center = New Point3d(2, 2, 0)
      acCirc.Radius = 1
      acCirc.Layer = sLayerName
 
      acBlkTblRec.AppendEntity(acCirc)
      acTrans.AddNewlyCreatedDBObject(acCirc, True)
 
      '' Save the changes and dispose of the transaction
      acTrans.Commit()
  End Using
End Sub

 Hello everybody,

when I use this code it is works. because I use it with commandMethos ("createAndAssignLayer").

but I want to use my code with button.

When I click to button, code must be run.

but it has a eror.

[Anonymous]

Hello,

Did you fix this issue?

I too have a same issue.

If you fix, please share the solution.

thanks,

thenndral

[norman.yuan]

You'd better description your problem in more details instead of just saying "same iisue", because the OP asked a very vague question (thus no one was willing to answer). What button was it? A toolbar buuton? A button from a modal form or modeless form? How the code is called from the button click...There simply too many things to assume before an answer can be offerred.

However, just a wild shoot in the dark, more likely reason for the same code working in the commmand method, but not when started from a form's user action, such as button click, is the document not being locked. That is, you may need to wrap the code inside

using (DocumentLock l=MyMdiDucment.LockDocument())

{

   //your code goes here

}