社区 › VB › Bricscad ET Chspace like command

hmspe 发表于 2010-4-10 08:28:59

Bricscad ET Chspace like command

我需要帮助。我正在尝试用Acad Express Tools Chang Space命令将实体从MS复制到PS，运气不佳。幸运的是，我使用VBA是因为它易于调试/运行。我想出了复制和旋转视图扭曲，但我似乎不能让transformcoordinates像我期望的那样工作。我需要将模型中的文本插入点转换到acadPViewport中的相同位置。有人在布里斯卡德做到了吗？我之所以说Bricscad，是因为扭曲似乎没有像我预期的那样工作，或者没有像样本Acad代码显示的那样工作。求助于方向目标。我一直有再生问题，当它从Mspace切换到Pspace可能会造成严重破坏。任何建议将不胜感激。
**** Hidden Message *****

冒险弓弓 发表于 2010-4-10 12:27:30

使用现有的快递工具会更容易。 如果您在Google上搜索“chspace.lsp”，则很容易获得。 allexperts.com 的版本来自Autodesk Australia，版权声明允许免费使用。 请注意，这与 Autocad 美国版本中的 Express 工具中的版本不同。 还有兰迪·金茨利（Randy Kintzley）发布的版本的副本，这就是美国快递工具中的内容。

超级粽子 发表于 2010-4-10 16:48:13

我认为这必须要做到，基本上我可以用base复制并实现同样的效果。如果有人能使用com、VBA或Vlax将MSpace坐标转换为PSace坐标，我仍感兴趣。

魔法 发表于 2010-4-10 23:47:36

嗨，杰瑞，
我的VBA咬，所以也许你可以翻译一下。我在几个端口上测试了这个，其中一些端口是旋转的(dview ),看起来工作正常..YMMV，但我希望它让你开始。
using System;
using System.Collections.Generic;
using System.Linq;
using System.Threading;
using System.Threading.Tasks;
using System.Diagnostics;
using BricscadApp;
using BricscadDb;
using RxNet.ApplicationServices;
using RxNet.Runtime;
using RxNet.Geometry;
using RxNet.RxGlobal;
namespace Bricscad
{
public static class Commands
{
    // from papaerspace vp is active
   
    public static void test01()
    {
      try
      {
      // get app stuff
      var app = Application.AcadApplication as AcadApplication;
      var doc = app.ActiveDocument;
      var mspace = doc.ModelSpace;
      GlobalFunctions.MSpace();
      //select an entity and copy
      object opnt, oent, pairs = null;
      doc.Utility.GetEntity(out oent, out opnt, "Select Entity");
      AcadEntity entity = oent as AcadEntity;
      AcadEntity[] ocol = { entity };
      object[] ncol = doc.CopyObjects((object)ocol, doc.PaperSpace, ref pairs);
      AcadEntity nentity = ncol as AcadEntity;
      // get the center of both entities bounding box
      Point3d cenent = getBBCenter(entity);
      Point3d cennent = getBBCenter(nentity);
      // scale
      nentity.ScaleEntity(cennent.ToArray(), doc.ActivePViewport.CustomScale);
      // rotate
      nentity.Rotate(cennent.ToArray(), doc.ActivePViewport.TwistAngle);
      // move
      nentity.Move(cennent.ToArray(),
          doc.Utility.TranslateCoordinates(
          cenent.ToArray(), AcCoordinateSystem.acUCS, AcCoordinateSystem.acPaperSpaceDCS, 0));
      // delete
      entity.Delete();
      GlobalFunctions.PSpace();
      }
      catch (System.Exception ex)
      {
      GlobalFunctions.Printf("\n{0}\n{1}",
         ex.Message, ex.StackTrace);
      }
    }
    static Point3d getBBCenter(AcadEntity ent)
    {
      object omin, omax;
      ent.GetBoundingBox(out omin, out omax);
      Point3d min = new Point3d((double[])omin);
      Point3d max = new Point3d((double[])omax);
      return new Point3d(min + ((max - min) / 2),
                         min + ((max - min) / 2), 0);
    }
}
}

萝卜扬的后花园 发表于 2010-4-10 23:50:26

突出显示的项目从MS克隆到PS，VP扭曲。。。

同年同月同日生 发表于 2010-4-11 00:21:34

适用于选择集，您可能希望过滤暗淡
using System;
using System.Collections.Generic;
using System.Linq;
using System.Threading;
using System.Threading.Tasks;
using System.Diagnostics;
using BricscadApp;
using BricscadDb;
using RxNet.ApplicationServices;
using RxNet.Runtime;
using RxNet.Geometry;
using RxNet.RxGlobal;
namespace Bricscad
{
public static class Commands
{
    // from papaerspace vp is active
   
    public static void test01()
    {
      AcadSelectionSet selection = null;
      try
      {
      // get app stuff
      var app = Application.AcadApplication as AcadApplication;
      var doc = app.ActiveDocument;
      GlobalFunctions.MSpace();
      selection = doc.SelectionSets.Add("MySel");
      selection.SelectOnScreen();
      foreach (AcadObject o in selection)
      {
          AcadEntity e = o as AcadEntity;
          if (e != null)
            cloneToPspace(e, doc);
      }
      foreach (AcadObject o in selection)
      {
          AcadEntity e = o as AcadEntity;
          if (e != null)
            e.Delete();
      }
      GlobalFunctions.PSpace();
      }
      catch (System.Exception ex)
      {
      GlobalFunctions.Printf("\n{0}\n{1}",
         ex.Message, ex.StackTrace);
      }
      finally
      {
      selection.Delete();
      }
    }
    static void cloneToPspace(AcadEntity entity, AcadDocument doc)
    {
      try
      {
      object pairs = null;
      AcadEntity[] ocol = { entity };
      object[] ncol = doc.CopyObjects((object)ocol, doc.PaperSpace, ref pairs);
      AcadEntity nentity = ncol as AcadEntity;
      // get the center of both entities bounding box
      Point3d cenent = getBBCenter(entity);
      Point3d cennent = getBBCenter(nentity);
      // scale
      nentity.ScaleEntity(cennent.ToArray(), doc.ActivePViewport.CustomScale);
      // rotate
      nentity.Rotate(cennent.ToArray(), doc.ActivePViewport.TwistAngle);
      // move
      nentity.Move(cennent.ToArray(),
          doc.Utility.TranslateCoordinates(
          cenent.ToArray(), AcCoordinateSystem.acUCS, AcCoordinateSystem.acPaperSpaceDCS, 0));
      }
      catch {/*hehe*/}
    }
    static Point3d getBBCenter(AcadEntity ent)
    {
      object omin, omax;
      ent.GetBoundingBox(out omin, out omax);
      Point3d min = new Point3d((double[])omin);
      Point3d max = new Point3d((double[])omax);
      return new Point3d(min + ((max - min) / 2),
                         min + ((max - min) / 2), 0);
    }
}
}

微笑 发表于 2010-4-11 05:46:16

小伙子，你做了全面的命令。 看起来不错。没有尝试过你的代码，因为我正处于特定用途的中间。 我得到了一张测量地图，上面有所有的注释（方位角，距离，注释......），需要分成3张，有两个不同的比例和重叠的区域。有些文本需要保持水平，有些是对齐的，有些是1：50，有些是1：100。无论如何，这是我处理过的VBA中的代码;
Sub msTxt2ps()
      Dim pp As Variant
      Dim pt1 As Variant
      Dim ent As AcadEntity
      Dim aTxt As AcadText
      Dim mTxt As AcadMText
      Dim nTxt As AcadText
      Dim amTxt As AcadMText
      Dim mAtt As Variant
      
      Dim ss As AcadSelectionSet
      Dim Code(0) As Integer
      Dim Val(0) As Variant
      Set ss = ThisDrawing.ActiveSelectionSet
      ss.Clear
          Code(0) = 0
          Val(0) = "TEXT,MTEXT"
         
   Dim styl As AcadTextStyle
   Set styl = ThisDrawing.ActiveTextStyle
      
      Dim ps As AcadPViewport
      Set ps = ThisDrawing.ActivePViewport
      pss = ps.CustomScale
      psrot = ps.TwistAngle
      
      ss.SelectOnScreen Code, Val
      ThisDrawing.ActiveSpace = acPaperSpace
For Each ent In ss
      If TypeOf ent Is AcadText Then
          Set aTxt = ent
          pt1 = aTxt.InsertionPoint
          pt1 = transPt(pt1)
          rot = Math.Round(aTxt.Rotation, 5)
          pt2 = aTxt.TextAlignmentPoint
          pt2 = transPt(pt2)
          txtht = aTxt.Height * pss
          Set nTxt = ThisDrawing.PaperSpace.AddText(aTxt.TextString, pt1, txtht)
          nTxt.Alignment = aTxt.Alignment
          nTxt.TextAlignmentPoint = pt2
          nTxt.InsertionPoint = pt1
               If rot = 0# Then
               nTxt.Rotation = 0#
               Else
               nTxt.Rotation = rot + psrot
               End If
          Else
          Set mTxt = ent
          pt1 = mTxt.InsertionPoint
          pt1 = transPt(pt1)
          rot = Math.Round(mTxt.Rotation, 5)
          wid = mTxt.Width
          mAtt = mTxt.AttachmentPoint
          Set amTxt = ThisDrawing.PaperSpace.AddMText(pt1, wid, mTxt.TextString)
          amTxt.AttachmentPoint = mAtt
               If rot = 0# Then
               amTxt.Rotation = 0#
               Else
               amTxt.Rotation = rot + psrot
               End If
          amTxt.StyleName = styl.Name
          amTxt.ScaleEntity pt1, pss
   End If
Next
      
End Sub
Function transPt(ByRef pt1 As Variant) As Variant
   pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acUCS, acDisplayDCS, 0)
   pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acDisplayDCS, acPaperSpaceDCS, 0)
   transPt = pt1
End Function

有趣的是，您不必将自定义比例因子应用于 Mtext.Width。至少在我看来是这样。
我将审查你的代码，以便将来我可以C#一些Mspace2Pspace工具。 谢谢。

水晶字 发表于 2010-4-11 07:23:57

干得漂亮！我看到您正在创建新实体，而我正在使用复制对象函数...为什么我需要缩放对象。
BTY，我只使用C#，因为我对它更满意。没有理由不能将其移植到VBA...它的所有 COM

杨佳 发表于 2010-4-12 05:19:28

我之所以创建新对象，是因为我想到了将它们放在新图层（当前图层）上的最简单方法，我不想删除原始对象，只需关闭它们，因为同一文本可能需要复制到不同的布局。出于同样的原因，我的下一个项目是将纪念碑符号（块）转换成PS。这将是简单的，除了符号包含擦除实体。复制它们似乎无法维持提款顺序。一旦他们进入纸面空间，将他们带到前台似乎取得了喜忧参半的成功。我一定忽略了什么。无论如何，必须尽快完成此映射，因此必须等待编写例程。

查看完整版本: Bricscad ET Chspace like command