''_______________________________CommandLine.vb_______________________________'' '' written by Tony Tanzillo The Great Imports System Imports System.Security Imports System.Runtime.InteropServices Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.Runtime Imports System.Collections Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.EditorInput 'Imports AcadApp = Autodesk.AutoCAD.ApplicationServices.Application Namespace CaddZone.ApplicationServices Public NotInheritable Class CommandLine ' Methods Shared Sub New() ResTypes.Item(GetType(String)) = &H138D ResTypes.Item(GetType(Double)) = &H1389 ResTypes.Item(GetType(Point3d)) = &H1391 ResTypes.Item(GetType(ObjectId)) = &H138E ResTypes.Item(GetType(Integer)) = &H1392 ResTypes.Item(GetType(Short)) = &H138B ResTypes.Item(GetType(Point2d)) = &H138A ResTypes.Item(GetType(Byte)) = &H138B End Sub _ Private Shared Function acedCmd(ByVal resbuf As IntPtr) As Integer End Function Public Shared Function Cmd(ByVal args As IList) As Integer If Application.DocumentManager.IsApplicationContext Then Return 0 End If Dim num As Integer = 0 Dim num2 As Integer = 0 Using buffer As ResultBuffer = New ResultBuffer Dim obj2 As Object For Each obj2 In args num2 += 1 buffer.Add(CommandLine.TypedValueFromObject(obj2)) Next If (num2 > 0) Then Dim strA As String = CStr(Application.GetSystemVariable("USERS1")) Dim flag As Boolean = (String.Compare(strA, "DEBUG", True) = 0) Dim num3 As Integer = IIf(flag, 1, 0) Dim systemVariable As Object = Application.GetSystemVariable("CMDECHO") Dim num4 As Short = CShort(systemVariable) If ((num4 <> 0) OrElse flag) Then Application.SetSystemVariable("CMDECHO", num3) End If num = CommandLine.acedCmd(buffer.UnmanagedObject) If ((num4 <> 0) OrElse flag) Then Application.SetSystemVariable("CMDECHO", systemVariable) End If End If End Using Return num End Function Public Shared Function Command(ByVal ParamArray args As Object()) As Integer If Application.DocumentManager.IsApplicationContext Then Return 0 End If Dim stat As Integer = 0 Dim cnt As Integer = 0 Using buffer As ResultBuffer = New ResultBuffer Dim o As Object For Each o In args cnt += 1 buffer.Add(CommandLine.TypedValueFromObject(o)) Next If (cnt > 0) Then Dim s As String = CStr(Application.GetSystemVariable("USERS1")) Dim debug As Boolean = (String.Compare(s, "DEBUG", True) = 0) Dim val As Integer = IIf(debug, 1, 0) Dim cmdecho As Object = Application.GetSystemVariable("CMDECHO") Dim c As Short = CShort(cmdecho) If ((c <> 0) OrElse debug) Then Application.SetSystemVariable("CMDECHO", val) End If stat = CommandLine.acedCmd(buffer.UnmanagedObject) If ((c <> 0) OrElse debug) Then Application.SetSystemVariable("CMDECHO", cmdecho) End If End If End Using Return stat End Function Private Shared Function TypedValueFromObject(ByVal val As Object) As TypedValue Dim obj2 As Object = CommandLine.ResTypes.Item(val.GetType) If (obj2 Is Nothing) Then Throw New InvalidOperationException("Unsupported type in Command() method") End If Return New TypedValue(CInt(obj2), val) End Function ' Sample member functions that use the Command() method. ' Note that by default, coordinate parameters are assumed ' to be UCS coordinates. If TransformToUcs is true and the ' current UCS is not set to WORLD, then coordiantes are ' assumed to be WCS coordinates, and will be transformed ' to current UCS coordinates. Public Shared Function ZoomExtents() As Integer Return Command("._ZOOM", "_E") End Function Public Shared Function ZoomCenter(ByVal center As Point3d, ByVal height As Double) As Integer Return Command("._ZOOM", "_C", center, height) End Function Public Shared Function ZoomWindow(ByVal corner1 As Point3d, ByVal corner2 As Point3d) As Integer Return Command("._ZOOM", "_W", corner1, corner2) End Function Public Shared Function ZoomExtents(ByVal corner1 As Point3d, ByVal corner2 As Point3d) As Integer Return Command("._ZOOM", "_E") End Function ' some dummy commands added i.e.: Public Shared Function InsertBlock(ByVal p As Point3d, ByVal bn As String, ByVal ang As Double) As Integer Return Command("._-INSERT", bn, p, 1, ang) End Function Public Shared Function InsertBlockRot(ByVal p As Point3d, ByVal bn As String, ByVal ang As Double) As Integer Return Command("._-INSERT", bn, "_R", ang, p, 1) End Function Public Shared Function InsertBlockScaleRot(ByVal p As Point3d, ByVal bn As String, _ ByVal xs As Double, ByVal ys As Double, ByVal ang As Double) As Integer Return Command("._-INSERT", bn, "_X", xs, "_Y", ys, "_R", ang, p) End Function Public Shared Function PasteWithBase(ByVal p As Point3d) As Integer Return Command("._PASTECLIP", p) End Function ' Fields Private Const ACAD_EXE As String = "acad.exe" Private Shared ResTypes As Dictionary(Of Type, Integer) = New Dictionary(Of Type, Integer) Private Const RT3DPOINT As Integer = &H1391 Private Const RTENAME As Integer = &H138E Private Const RTLONG As Integer = &H1392 Private Const RTNONE As Integer = &H1388 Private Const RTNORM As Integer = &H13EC Private Const RTPOINT As Integer = &H138A Private Const RTREAL As Integer = &H1389 Private Const RTSHORT As Integer = &H138B Private Const RTSTR As Integer = &H138D End Class End Namespace ''_______________________________Commands.vb_______________________________'' Imports System Imports System.Security Imports System.Runtime.InteropServices Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.Runtime Imports System.Collections Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.EditorInput Imports cmd = JigRectang.CaddZone.ApplicationServices.CommandLine Namespace DefaultNameSpace Public Class Commands _ Public Sub applyPasteClip() 'here is a semi-solution, because of 'you have to copy with base point manually before! Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor Dim pr As PromptPointResult = ed.GetPoint(vbLf & vbLf & "Specify insertion point: ") If pr.Status <> PromptStatus.OK Then Return End If Dim pt As Point3d = pr.Value cmd.PasteWithBase(pt) End Sub End Class End Namespace