填充t的非lisp方法
我正在设计一种在测量图上将窗口高度制成表格的快速方法。我们测量窗户的顶部和底部，然后在平面图中显示。我们的绘图工具目前将高度输入表格。我突然想到，可能有一种方法可以一次拾取一个文本对象（包含高度），然后将每个值粘贴到表的下一行。
有人给了我灵感让我从这里开始吗？我正在寻找非lisp解决方案。 你能举一个例子，一个有文字和填充表的窗口绘图，它总是有助于看到一个问题，例如它是文字，多行文字或属性。 谢谢你的回复，史蒂文。我知道这很难。这里有更多信息。
https://www.cadtutor.net/forum/attachment.php?attachmentid=56218&cid=1&stc=1
橙色文字都是单行文字对象。较小的数字表示窗台的标高，而较大的数字表示窗头的标高。
我必须把它们输入这样的表格中：
https://www.cadtutor.net/forum/attachment.php?attachmentid=56219&cid=1&stc=1
我已经有了一个宏，当我穿过并拾取每个窗口时，它会用递增的数字标记每个窗口。
随附样品图纸。WindowTables。图纸
我知道Steven是LT的天才，但根据你的PM，如果你说Briscad，你可以很容易地使用一个块而不是一个表拾取窗口编号拾取文本来完成这项工作。“时间表”已更新，我们对排水坑时间表执行此操作。它将第一个id与第一个属性匹配，以便它知道填充时间表的块可以位于图形中的任何位置。根据图像，信息来自dwg的大约4个不同部分。
有趣的它如何知道块中有多少行？例如，如果你的凹坑比正常的多怎么办？进程可以添加行吗？
你用lisp激活它吗？
谢谢你的想法。 我的第一反应是，像比加尔所说的那样建议一个区块（不确定与布里斯卡德的联系？）。应该可以创建一个块，在插入数字时自动增加数字，然后填充属性值，而不是使用文本，这样它就不会读取现有文本，这是一种替代的工作方法。块信息很容易更改，可以读取到csv文件并导入excel，从那里可以将其作为表格读回Autocad。
如果没有LISP或类似的编程选项，我们这些使用LT的人只能找到不同的工作方法，因此很难将其作为一个单键解决方案。
我的下一个问题是，看到您的图形，有两个门槛标高值（您为表格选择哪个值）
您需要多久创建一次这样的图形？如果是全天、每天，那么肯定有其他选项可以节省时间（但它们需要一段时间才能设置，因此不适合偶尔使用）
如果这是一个经常使用的过程，那么了解您现在使用的实际过程会很有帮助。如何收集测量数据，谁将其输入图形，如何输入等。 YZ没有那么难，你有一个块，但在一个普通的线型网格中插入了多次，使其看起来像一个表格，可以有多少行，你有一个属性，具有唯一的值，在示例中是点号，这是在代码中首先选择的，它是块或文本，是的，有一点手动复制或编辑坑号，但如果你看一下明细表，大约有15列输入，而这些信息并不都在一个地方。添加下一行是我需要做的事情之一。代码支持文本，因此在您的情况下“Window-23”是可以的。
发布一个简单的dwg，我很感谢你只有LT，但正如你提到的，可能是升级，所以为什么不到一个支持lisp的Autocad替代品。再做一次20分钟的任务，现在大约10秒，你算出你节省的钱。
Public Sub ModifyPitSchedule2()
' puts in 1 pt x and y's plus length and width
Dim SS As AcadSelectionSet
Dim objENT As AcadEntity
Dim Count, Cntr As Integer
Dim Newpitname As String
Dim pitname As String
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
Dim PitNameSelect As AcadObject
Dim basepnt, pt1, pt2, pt3 As Variant
Dim attribs As Variant
On Error Resume Next
Newpitname = "1" 'dummy to pass then return changed
pitname = Getpitname(Newpitname)
MsgBox "pitname selected is " & pitname
basepnt = ThisDrawing.Utility.GetPoint(, " Pick PIT center ")
ptxtx1 = CStr(FormatNumber(basepnt(0), 3))
ptxty1 = CStr(FormatNumber(basepnt(1), 3))
pt1 = ThisDrawing.Utility.GetPoint(, " Pick 1st point ")
pt2 = ThisDrawing.Utility.GetPoint(, " pick 2nd point L ")
pt3 = ThisDrawing.Utility.GetPoint(, " pick 3rd point W ")
lx = Abs((pt1(0) - pt2(0)))
ly = Abs((pt1(1) - pt2(1)))
lz = Int((lx ^ 2 + ly ^ 2) ^ 0.5 * 10000) / 10
lengthpit = CStr(FormatNumber(lz, 0))
lx = Abs((pt2(0) - pt3(0)))
ly = Abs((pt2(1) - pt3(1)))
lz = Int((lx ^ 2 + ly ^ 2) ^ 0.5 * 10000) / 10
widthpit = CStr(FormatNumber(lz, 0))
'This will clear out old selectionsets, and prevent the "selection set already exists" error
If ThisDrawing.SelectionSets.Count > 1 Then
For Cntr = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(Cntr).Delete
Next Cntr
End If
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
Set SS = ThisDrawing.SelectionSets.Add("pit2sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
BLOCK_NAME = "SCHEDTEXT"
For Cntr = 0 To SS.Count - 1
If SS.Item(Cntr).Name = BLOCK_NAME Then
attribs = SS.Item(Cntr).GetAttributes
If attribs(0).TextString = pitname Then
attribs(1).TextString = ptxtx1
attribs(2).TextString = ptxty1
attribs(5).TextString = lengthpit
attribs(6).TextString = widthpit
attribs(1).Update
attribs(2).Update
attribs(5).Update
attribs(6).Update
Cntr = SS.Count
End If
End If
Next Cntr
ThisDrawing.SelectionSets.Item("pit2sel").Delete
End Sub
Function Getpitname(Newpitname As String) As String
Dim PitNameSelect As AcadObject
Dim pitattribs As Variant
ThisDrawing.Utility.GetEntity PitNameSelect, basepnt, "pick pit name : "
If PitNameSelect.ObjectName = "AcDbText" Then
Getpitname = PitNameSelect.TextString
End If
If PitNameSelect.ObjectName = "AcDbBlockReference" Then
pitblname = PitNameSelect.Name ' RETURNS BLOCK NAME
pitattribs = PitNameSelect.GetAttributes
Getpitname = pitattribs(0).TextString
End If
End Function
页:
[1]