社区 › Auto Lisp › [vb.net]UCS问题

frostrap 发表于 2022-7-6 17:06:12

[vb.net]UCS问题

嗯，我在vb方面进展很慢。网
 
这是我最近的一期：
 
我有一个程序，它会提示输入两个端点，然后根据这些端点插入一条线。插入直线后，程序还会在直线的中心点插入一个块。
 
当UCS处于正常位置（与WCS对齐？）时，该程序工作正常。
 
但是，如果我以任何方式移动UCS（例如旋转15度），线和块最终会插入到图形上的奇数位置。它们的大小和相对方向正确，但它们的整体插入点不正确。
 
我会发布一些代码，但这不是很直截了当。但是，我使用标准方法从编辑器中获取用户输入，并将线条和块插入到活动图形数据库中。
 
我的猜测是，当用户输入这两个点时，AutoCAD正在将这些点转换为某些WCS坐标，当插入线和块时，这些坐标不会转换回当前UCS。不幸的是，我不知道如何解决这个问题（假设这就是问题所在）。
 
你知道这可能是什么原因吗？

SEANT 发表于 2022-7-6 17:26:30

是的，这是一个翻译问题，需要与VBA类似的步骤。
 
下面是一个vb。net演示。与大多数演示代码一样，错误检查应该修改到所需的任何级别。
 
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry

Public Class STSCCommands
   <CommandMethod("BTM")> _
   Public Sub Tester()
       Dim strBlkName As String = "Arrow_E" 'change to suit
       Dim strBlkPath As String = "C:\STCustomCommon\Arrow_E.dwg" 'change to suit

       If Block2Mid(strBlkName, strBlkPath) Then
         Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbCr & "Block insertion successful.")
       End If
   End Sub


   Public Function Block2Mid(ByVal strBlkName As String, ByVal strBlkPath As String) As Boolean
       Dim db As Database = HostApplicationServices.WorkingDatabase
       Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim ucsMat As Matrix3d = ed.CurrentUserCoordinateSystem
       Dim bt As BlockTable
       Dim btr As BlockTableRecord
       Dim btrSpace As BlockTableRecord
       Dim entBref As BlockReference
       Dim ppo As PromptPointOptions = New PromptPointOptions("Select first point: ")
       ppo.AllowNone = False
       ppo.AllowArbitraryInput = False
       Dim ppr As PromptPointResult = ed.GetPoint(ppo)
       If ppr.Status = PromptStatus.Cancel Or ppr.Status = PromptStatus.Error Then Exit Function
       Dim p3d1 As Point3d = ppr.Value
       ppo.UseBasePoint = True
       ppo.BasePoint = p3d1
       ppo.Message = vbCr & "Select second point: "
       ppr = ed.GetPoint(ppo)
       If ppr.Status = PromptStatus.Cancel Or ppr.Status = PromptStatus.Error Then Exit Function
       Dim p3d2 As Point3d = ppr.Value
       Dim v3d1 As Vector3d = p3d1.GetAsVector()
       Dim v3d2 As Vector3d = p3d2.GetAsVector()
       v3d2 = v3d2 - v3d1
       v3d2 = v3d1 + (v3d2 / 2.0)
       Dim midPt As Point3d = New Point3d(v3d2.ToArray())
       p3d1 = p3d1.TransformBy(ucsMat)
       p3d2 = p3d2.TransformBy(ucsMat)
       midPt = midPt.TransformBy(ucsMat)
       Dim entLine As Line = New Line(p3d1, p3d2)
       Using tr As Transaction = db.TransactionManager.StartTransaction()
         bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
         If bt.Has(strBlkName) Then
               btr = tr.GetObject(bt.Item(strBlkName), OpenMode.ForRead)
         Else
               btr = RtrvBlk(strBlkName, strBlkPath, ed, db)
               If btr = Nothing Then
                   Block2Mid = False
                   Exit Function
               End If
         End If
         Try
               btrSpace = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
               btrSpace.AppendEntity(entLine)
               entBref = New BlockReference(midPt, btr.ObjectId)
               entBref.Normal = ucsMat.CoordinateSystem3d.Zaxis
               entBref.Position = midPt 'requires re-positioning after Normal mod
               btrSpace.AppendEntity(entBref)
               tr.AddNewlyCreatedDBObject(entLine, True)
               tr.AddNewlyCreatedDBObject(entBref, True)
               tr.Commit()
         Catch ex As System.Exception
               ed.WriteMessage(ex.Message)
               Block2Mid = False
         End Try
         Block2Mid = True
       End Using
   End Function


   Public Function RtrvBlk(ByVal strBlkName As String, ByVal strBlkPath As String, ByRef ed As Editor, ByRef db As Database) As BlockTableRecord
       Dim bt As BlockTable
       Dim btr As BlockTableRecord = Nothing
       Dim id As ObjectId
       Dim actDoc As Document = Application.DocumentManager.MdiActiveDocument
       Using tr As Transaction = db.TransactionManager.StartTransaction()
         Try
               bt = tr.GetObject(db.BlockTableId, OpenMode.ForWrite)
               Using importDb As Database = New Database(False, False)
                   Try
                     importDb.ReadDwgFile(strBlkPath, IO.FileShare.Read, True, "")
                     id = db.Insert(strBlkPath, importDb, True)
                     btr = tr.GetObject(id, OpenMode.ForWrite)
                     btr.Name = strBlkName
                     btr.DowngradeOpen()
                   Catch ex As System.Exception
                     ed.WriteMessage(ex.Message)
                     Return Nothing
                     Exit Function
                   Finally
                     importDb.Dispose()
                   End Try

               End Using
               tr.Commit()
         Catch ex As System.Exception
               ed.WriteMessage(ex.Message)
         End Try
       End Using
       Return btr
   End Function

End Class

frostrap 发表于 2022-7-6 17:42:09

好的，听起来所有的点输入都是根据WCS进行的，然后使用转换矩阵转换为当前UCS。
 
感谢您提供示例代码。是你写的还是从其他资源获得的？
 
-乔

SEANT 发表于 2022-7-6 17:53:53

一般来说，我发布的所有内容都是自己写的。我不一定会因为这样一个相当通用的例程而受到赞扬（当我说通用时，我指的是一个可能已经编写过多次的例程，不一定是一个容易编写的例程）。这种通用性（因为这项任务的需求非常普遍）意味着有用的代码片段相当丰富，我可以到处借用——呵呵——部分内容。
 
UCS的大部分内容与VBA非常相似，因此以前的经验非常有用。
 
既然我已经承认了这本《汇编》的大部分所有权，我希望真正的专业人士会过来告诉我，我真的应该做些什么才能让它变得更好。

frostrap 发表于 2022-7-6 18:03:49

哈，对我来说已经够好了。
 
可以看出，我仍在努力找出在后台处理AutoCAD的细节。有时试图记住事物是如何结构的可能有点令人畏惧。
 
我刚刚开始学习转换，这是很好的知识。
 
谢谢你的帮助。

SEANT 发表于 2022-7-6 18:12:58

尽管灾难的严重性。NET api，转换是简化过程的一个领域；至少与VBA相比。一旦定位，很多。NET工具随时可用。
 
 
不客气。

查看完整版本: [vb.net]UCS问题