colmguckian 发表于 2022-7-6 22:37:06

访问关闭的图形

我有一个代码可以更改图形中的标注样式
从DimStyle1到Dimstyle2
 
如果dimstyle 2位于闭合图形上,是否可以从dimstyle1更改为dimstyle2。如果是这样,我应该对代码做什么更改。
 

Public Class Class2
<CommandMethod("changedimstyle")> _
Public Sub ChangeDimStyle()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using trx As Transaction = db.TransactionManager.StartTransaction()
Dim dimTbl As DimStyleTable = trx.GetObject(db.DimStyleTableId, OpenMode.ForRead)
Dim dimDtr As DimStyleTableRecord = trx.GetObject(dimTbl("DimStyle1"), OpenMode.ForRead)
Dim ids As ObjectIdCollection = dimDtr.GetPersistentReactorIds()
For Each objId As ObjectId In ids
If objId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(Dimension))) Then
Dim dimen As Dimension = trx.GetObject(objId, OpenMode.ForWrite)
dimen.DimensionStyleName = "DimStyle2"
End If
Next
trx.Commit()
End Using
End Sub
End Class

meyerforhire 发表于 2022-7-6 23:20:29

我将向您展示如何处理图层、文本样式、块以及其他任何内容。当然,并不是下面的一切都是我的;我找到了其中的大部分,并根据需要进行了调整。肖特,我相信他是最初的作者,他似乎是在飞行中完成了所有这一切——我没有那么好/聪明。但是,我知道怎么做,那就是足智多谋!http://www.cadtutor.net/forum/archive/index.php/t-26666.html
 
首先,使用此功能可以利用AutoCAD打开自己文档的能力,或者类似的功能。如果我没记错的话,这个函数曾经测试过你运行的Acad版本是否在16及以下。因此,如果您使用的是AutoCAD 2000i或更高版本,则需要遵循上面的链接。这对我来说很有效,没有测试。
 
Function GetAcDbxDoc() As Object
Dim strAcadVersion As String
With ThisDrawing.Application

strAcadVersion = Mid(.Version, 1, 2)

Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument." & strAcadVersion)

End With
End Function
 
接下来,您将使用下面的命令将要查找的任何对象复制到当前图形的数据库中。这一个恰好复制了一个特定的文本样式。
 
Sub GetTextStyle(tStyl As String)
Dim objStyl As AcadTextStyle
Dim objStyls As AcadTextStyles
Dim objArray(0) As Object
Dim ACDbx As Object
Set ACDbx = GetAcDbxDoc()
ACDbx.Open blkFil
'blkFil is a Global variable I have set to a particular file in my arsenal
'just use whatever file name
Set objStyls = ACDbx.TextStyles
Set objStyl = objStyls.Item(tStyl)
Set objArray(0) = objStyl
ACDbx.CopyObjects objArray, ThisDrawing.TextStyles
Set ACDbx = Nothing
Set objStyls = Nothing
Set objStyl = Nothing
Set objArray(0) = Nothing
End Sub
 
如果我没记错的话,这个sub最初是为复制块而写的,我不确定它是否适用于层等,但它确实适用。我认为需要记住的一件大事是,必须将对象放入数组中。只需更改上面的一些变量,就可以轻松实现dim样式。
 
一旦你有了昏暗的风格,就这样做:
 
ThisDrawing.ActiveDimStyle = WhatEverDimStyle
 
希望这有助于并感谢肖特的智慧。
 
我忘了提一下,您应该进行测试,以确保您正在寻找的昏暗风格没有恰好出现在图纸中:
 
Public Function TestStyle(tStyl As String) As Boolean

Dim objStyl As AcadTextStyle
Dim i As String
For Each objStyl In ThisDrawing.TextStyles
If objStyl.Name = tStyl Then
i = "True"
Else
End If
Next
If i = "True" Then
TestStyle = True
Else
TestStyle = False
End If
End Function

 
这是我写的,所以对我来说是的。。。。。

Jeff H 发表于 2022-7-7 00:02:39

你们可以只使用数据库。ReadDwgFile将DIMSTYLETABLERRECORD添加到图形中,然后执行相同操作。
页: [1]
查看完整版本: 访问关闭的图形