在文本周围创建矩形

Zeusovsky · 发表于 2022-7-6 22:56:16

我想解决这个问题。

这就是问题所在。我创建了一个程序来增加文本的大小，文本。身高

现在，文本有时与其他对象相交，当这个附加时，我获取文本。如果对象文字与图形上的其他对象相交，则插入点并上下左右移动一点，然后使用intersectwith命令进行查看。

但有时相交会给我一个假相交，例如，如果我有一个旋转度为6.13度的文本，程序会给我一个与文本767R2654-1052FC-2

一个错误的相交，autocad在文本周围创建一个边界框，但该框不考虑文本旋转，该框不在旋转角度上，就像使用QTEXT命令创建的框一样，我需要一个类似于QTEXT的框，但QTEXT无法获取并用于相交。可能是一条多段线，如QText框。

现在，如果文本与黄色多段线相交，我需要在文本周围放置一个框以供查看。我需要对7894个dxf图形执行此操作，我有一个dxf图形和路径的列表，autocad会自动逐个文件打开，并增加大小，移动带有交叉点的文本，但问题是错误的交叉点。所以我需要一个围绕文本创建矩形的代码，我尝试使用命令Qtext，但我无法获得矩形，我尝试创建文本。GetBoundingBox（MinPnt，MaxPnt）结果是（0,0）上的一个框。

我的两个功能代码
私有函数Intersecta（Texto作为AcadObject）作为布尔值
'Dim Entidades（）作为AcadObject
Dim Entidades（）作为AcadEntity
Dim InsPntTexto作为变量，InsPntEntidades（）作为变量
Dim BETA作为变体
Dim y为整数，w为整数
对于y=0，此图形。阻碍。计数-1
对于w=0，此图纸。阻碍。项目（y）。计数-1
“ReDim实体（2）
ReDim实体（1）
'ReDim InsPntEntidades（0）
ReDim InsPntEntidades（2）
出错时继续下一步
设置实体（1）=此图形。阻碍。项目（y）。项目（w）
InsPntTexto=文本。插入点
β=实体（1）。插入点
InsPntEntidades（0）=β（0）：InsPntEntidades（1）=β（1）：InsPntEntidades（2）=β（2）
'InsPntEntidades=Entidades（1）。插入点
如果InsPntTexto（0）=InsPntEntidades（0）和InsPntTexto（1）=InsPntEntidades（1）和Entidades（1）。EntityName=“AcDbText”然后
GoTo阿莫诺斯
其他的
如果（IntersectWith（Texto，Entidades（1）））=True，则
“MsgBox”intersecta“
Wrksheet。单元格（行数，9）=“X:&实体（1）。实体名字
Intersecta=真
退出功能
其他的
Intersecta=假
如果结束
如果结束
阿莫诺斯：
下一个w
下一个
结束函数
公共函数与布尔值相交（Object1作为AcadEntity，Object2作为AcadEntity）
变光交叉点
交点=对象1。IntersectWith（Object2，AcExtendOption.acExtendNone）
如果UBound（交点）=-1，则
IntersectWith=假
其他的
IntersectWith=真
如果结束
结束函数

谢谢你的帮助。

文本移动代码

私有子更改大小（）
Dim Texto作为AcadObject
Dim i为整数
尺寸z为整数
对于该图纸的i=0。阻碍。计数-1
对于z=0，此图形。阻碍。项目（i）。计数-1
出错时继续下一步
设置Texto=ThisDrawing。阻碍。项目（i）。项目（z）
如果是文本。EntityName=“AcDbText”然后
如果UCase（Trim（Texto.TextString））像“*BK*”或UCase（Trim（Texto.TextString））像“*FC*”，那么
Wrksheet。单元格（行数，5）=文本。身高
此图纸。阻碍。项目（i）。项目（z）。高度=0.26
此图纸。Regen Acall视口
如果Intersecta（Texto）=True，则Movimientos i，z
Wrksheet。单元格（行数，6）=此图形。阻碍。项目（i）。项目（z）。身高
Wrksheet。单元格（行数，7）=文本。文本字符串
如果是Wrksheet。单元格（RowCount，10）=“impossible Correct”然后
Alfa=假
其他的
阿尔法=真
如果结束
如果结束
如果结束
如果错误为0，则错误。清楚的
下一个z
下一个i
末端接头

公共子动作（i为整数，z为整数）
Dim相交为布尔值
Dim TextObjPoint作为变体
Dim ObjectUnknowPoint作为变体
变光旋转
Dim pi作为变型
作为布尔值的Dim Correction
Dim Texto作为AcadObject
pi=4*Atn（1）
设置Texto=ThisDrawing。阻碍。项目（i）。项目（z）
如果是文本。EntityName=“AcDbText”然后
如果UCase（Trim（Texto.TextString））像“*FC*”或UCase（Trim（Texto.TextString））像“*BK*”，则“Izquierda”
“**********************************位置修正”************************
TextObjPoint=Texto。插入点
ptn=文本。插入点
旋转=文本。旋转
此图纸。Regen Acall视口
“伊兹奎尔达
TextObjPoint（0）=TextObjPoint（0）+（0.4*（（2*Cos（旋转-pi）））
TextObjPoint（1）=TextObjPoint（1）+（0.4*（（2*Sin（旋转-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
如果相交A（本图纸。块。项目（i）。项（z））=则为True
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
“德雷查
TextObjPoint（0）=TextObjPoint（0）-（0.4*（（2*Cos（旋转-pi）））
TextObjPoint（1）=TextObjPoint（1）-（0.4*（（2*Sin（旋转-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
应用缩放范围
如果相交A（本图纸。块。项目（i）。项（z））=True，则为“*****Abajo”
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
“Abajo
TextObjPoint（0）=TextObjPoint（0）+（0.2*（（2*Sin（旋转-pi）））
TextObjPoint（1）=TextObjPoint（1）+（0.2*（（2*Cos（旋转-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
如果相交A（本图纸。块。项目（i）。项（z））=True，然后为'******Arriba
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
'阿里巴
TextObjPoint（0）=TextObjPoint（0）-（0.2*（（2*Sin（旋转-pi）））
TextObjPoint（1）=TextObjPoint（1）-（0.2*（（2*Cos（旋转-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
如果相交A（本图纸。块。项目（i）。项（z））=True，然后为'******Abajo Derecha
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
“Abajo Derecha
TextObjPoint（0）=TextObjPoint（0）-（0.2*（（2*Cos（旋转-45-pi）））
TextObjPoint（1）=TextObjPoint（1）-（0.2*（（2*Sin（旋转-45-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
如果Intersecta（Texto）=True，则“****Abajo Izquierda”
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
“Abajo Izquierda
TextObjPoint（0）=TextObjPoint（0）+（0.2*（（2*Cos（旋转+45-pi）））
TextObjPoint（1）=TextObjPoint（1）+（0.2*（（2*Sin（旋转+45-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
如果相交A（本图纸。块。项目（i）。项（z））=True，则为'****Arriba Derecha
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
“Arriba Derecha
TextObjPoint（0）=TextObjPoint（0）-（0.2*（（2*Sin（旋转+45-pi）））
TextObjPoint（1）=TextObjPoint（1）-（0.2*（（2*Cos（旋转+45-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
如果Intersecta（Texto）=True，则'****Arriba Izquierda
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
“Arriba Izquierda
TextObjPoint（0）=TextObjPoint（0）+（0.2*（（2*Sin（旋转-45-pi）））
TextObjPoint（1）=TextObjPoint（1）+（0.2*（（2*Cos（旋转-45-pi）））
文本。插入点=TextObjPoint
此图纸。Regen Acall视口
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Arriba Izquierda”结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Arriba Derecha”结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Abajo Izquierda”结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Abajo Derecha”结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Arriba”，则结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Abajo”，则结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“****Derecha”，则结束
其他的
Wrksheet。单元格（行数，10）=“OK RW”
阿尔法=真
GoTo Vamonos公司
如果“FC和BK Izquierda”结束
如果“AcDbText”，则结束
如果相交A（本图纸。块。项目（i）。项（z））=True Then’Corrección Impossible
文本。插入点=ptn
TextObjPoint=Texto。插入点
此图纸。Regen Acall视口
Wrksheet。单元格（行数，10）=“不可能正确”
应用缩放范围
如果结束
瓦莫诺斯：
末端接头