修改blo的AutoLISP例程

Serabis · 发表于 2022-7-6 07:22:38

因此，为了提供一些背景信息，我没有LISP编程经验，我是一家工程公司的实习生。我真的很想通过自动化一项极其无聊和耗时的任务来获得“布朗尼分数”。我有其他语言的经验，可以打好基础。下面是我希望例行程序能够完成的内容：

1）找出标题栏的名称（标题栏将位于每个文件的相同位置）
2）使用该名称修改该块的5个属性值（每个标题块具有相同的属性标记：名称、图纸编号、序号、日期、设计器）
3）保存在新位置。

例如，假设我要修改的图形位于位置C:/USER/ME/，称为drawing1。图纸。假设它的标题块称为“blanksheet”，那么例程需要修改块“blanksheet”的5个属性（名称：DrawingName，DRAWING_NUM:123456，序号：000，日期：10 10 12，设计器：Me）。然后，在修改所有内容后，将其保存在位置C:/USER/YOU中，称为drawing2。图纸。

我甚至不确定这在AutoLISP的范围内是否可行，因此非常感谢您的反馈。

提前感谢！

nod684 · 发表于 2022-7-6 07:28:38

欢迎来到CAD导师！

这有帮助吗？
http://www.lee-mac.com/batte.html

BIGAL · 发表于 2022-7-6 07:37:00

下面是一个VBA示例和一个VL Lisp示例，用于执行您想要的操作。VBA使用属性顺序，VL使用属性标记搜索。

copy

Public Sub issued_for_construction()
' This Updates the Issued for construction and sets rev 0
Dim SS As AcadSelectionSet
Dim Count As Integer
Dim FilterDXFCode(1) As Integer
Dim FilterDXFVal(1) As Variant
Dim attribs As Variant
Dim BLOCK_NAME As String
On Error Resume Next
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       
       
       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"
       
       attribs(0).Update
       attribs(3).Update
       
Next Cntr
ThisDrawing.SelectionSets.Item("issued").Delete
'DO AGAIN FOR REVTABLE
'DATE
'Dim MyDate
'MyDate = Date
Call DashDate
FilterDXFCode(1) = 2
FilterDXFVal(1) = "REVTABLE"
BLOCK_NAME = "REVTABLE"
Set SS = ThisDrawing.SelectionSets.Add("revs")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       
       
       attribs(0).TextString = "0"
       attribs(1).TextString = DashDate
       attribs(2).TextString = "ISSUED FOR CONSTRUCTION"
       
       
       
       attribs(0).Update
       attribs(1).Update
       attribs(2).Update
       
Next Cntr
ThisDrawing.SelectionSets.Item("revs").Delete
MsgBox "Drawing now changed to Issued for Construction"
End Sub

VL

copy

; changes to issued for construction
: thanks to lee mac for original code
(vl-load-com)
; 1.  Get current date in mm/dd/yy format.
(defun ddmmyy (/ x today)
    (setvar "cmdecho" 0)
    (setq x (getvar "CDATE"))                 ; get current date
    (setq today ( rtos x 2 4))                    ; convert to a string
    (setq date (strcat (substr today 7 2) "."    (substr today 5 2) "." (substr today 3 2) ))
)
(setq oldtag1 "DRAWING_STATUS") ;attribute tag name
(setq newstr1 "ISSUED FOR CONSTRUCTION")
(setq oldtag2 "REV_NO")  ;attribute tag name
(setq newstr2 "0")
(setq ss1 (ssget "x"  '((0 . "INSERT") (2 . "DA1DRTXT"))))
(setq inc (sslength ss1))
(repeat inc      
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (setq inc (1- inc)) )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1) 
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2) 
) ; end if
) ; end for
) ;end repeat
(setq oldtag1 "REV-NO")
(setq newstr1 "0")
(ddmmyy)
(setq oldtag2 "DATE")
(setq newstr2 date)
(setq oldtag3 "AMENDMENT")
(setq newstr3 "ISSUED FOR CONSTRUCTION")
(setq ss2 (ssget "x"  '((0 . "INSERT") (2 . "REVTABLE"))))
(setq inc (sslength ss2))
(repeat inc
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq inc (1- inc)))) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1) 
)
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2) 
)
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr3) 
)
)
)
(setq ss1 nil)
; (setq ss2 nil)
(princ)

Serabis · 发表于 2022-7-6 07:42:53

点头，谢谢你的热情欢迎！李·麦克开发的程序运行得令人惊讶，但它只有几个问题：
1）它没有提供保存到新位置的选项，如果有人使用它并把事情搞砸了，我不希望100多个图形被搞砸。
2）我开发这个是为了方便使用，使用它的人可能甚至不知道块名，更不用说它的属性标记了。

我真的希望我能看到它生成的代码片段来修改一个图形，然后我可以用它来创建我自己的lisp文件。

但是，我注意到它被称为批处理属性编辑器，这是否意味着它组合了一个Lisp例程（或其中的多个），然后使用批处理脚本来运行每个Lisp例程？因为如果是这种情况，我可能不仅需要开发一个AutoLISP例程，还需要一个批处理文件来运行它们。

如果不是这样，我可以有一个长的LISP例程，它有许多“打开”和“保存”来修改大量图形，有点像AutoCAD脚本文件吗？

Bigal，我今天会处理您提供的代码，看看是否可以回答我自己的一些问题。感谢您的回复！

Serabis · 发表于 2022-7-6 07:49:02

此外，我不确定它是否有多大帮助，但我不必查找块的名称，我要编辑的每个标题块都以单词表开始，因此我打赌有一种方法可以合并通配符，使“查找”块更容易。

nod684 · 发表于 2022-7-6 07:52:25

这个程序对我很有用。。。

我要做的是，我暂时将我想要编辑的文件保存在一个新文件夹中，然后我从那里更改了，这样如果出现问题（我们不能说），我仍然保留着我的文件

对于查询的第2项，有一个选择块选项，因此您不需要知道块的名称，一旦您选择了块，您只需双击它并输入所需的值。

它确实是一个批处理属性编辑器，我不认为它结合了lisp，也不确定它是否也使用了脚本。。

但是，如果您想为多个图形运行自己的lisp/script，可以使用Lee的编剧，可在此处找到：
http://www.lee-mac.com/scriptwriter.html

BIGAL · 发表于 2022-7-6 07:57:05

您可以编写非常简单的脚本文件来执行您想要的操作。它看起来像这样，另存为lisp将基于现有图形名称设置新的目标名称。

copy


Open dwg1 (load "issued")(load "saveas")  close
Open dwg2 (load "issued")(load "saveas")  close
Or
Open dwg1 (load "issued") saveas c:\\mydirectory\dwg1 close
Open dwg2 (load "issued") saveas c:\\mydirectory\dwg2 close

copy

 
For sheet blocks something like 
(setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 "sheet*"))))
then you could compare names to a list etc

Lapdog1968 · 发表于 2022-7-6 08:05:17

使用字段

Lee Mac · 发表于 2022-7-6 08:09:18

谢谢你Serabis。

对于任何自动修改大量图形的此类程序，我始终建议您对图形副本进行操作，以防出现任何错误。我对我的计划充满信心，但无法提供任何保证。。。

如果要继续我的程序，可以选择将块和标记组合保存到外部文件（txt/csv），然后在将来使用程序时加载属性数据-这样，块和标记名称只需输入一次，并且可以从对话框中修改值。

我的程序生成并运行AutoCAD脚本，然后调用AutoLISP函数对每个图形执行必要的属性修改。

Serabis · 发表于 2022-7-6 08:14:49

很抱歉这么晚才回复大家，但我有点忙。

但我非常感谢大家！我能根据你的建议想出一个解决办法。

为了帮助任何可能遇到此线程的人，可以使用-attedit命令在块内编辑所需内容。将其与“打开”、“保存”和“关闭”命令相结合，您可以获得一个脚本文件，该文件可以打开文档，对其进行修改，将其保存到指定位置，然后自行关闭。为了修改大量的图形，我制作了一个自定义的excel宏（使用VBA），该宏循环生成基于某些单元格内容的脚本文件。这可以使用“Open”scriptfile.scr“For Output As#1”打开输出文件，然后使用“Print#1，“text”；”（the；suppress a newline）将一行文本输出到“打开”的文件。

如果你还有问题，我会检查这个帖子，这样我可以回答他们。

此外，如果你不想做任何工作，李Mac的批属性编辑器是一个了不起的解决方案。

[编程交流] 修改blo的AutoLISP例程

发表回复

精选推荐