社区 › Auto Lisp › 动态块提取到表

Spaj 发表于 2022-7-5 17:12:06

动态块提取到表

你好
 
我正在尝试编写一个LISP例程，将图形中许多特定动态块的特定属性制成表格。我设法找到了下面的代码（多亏了Fixo？和HMSilva），它被修改为只识别外部参照块。如何删除对此进行测试的逻辑？我已经确定了测试这种情况的代码（IsXref），但如何消除这种情况我一直没有找到。
 
最后，我想在表中包括每个块的起点和终点的坐标。
 
;| http://www.cadtutor.net/forum/showthread.php?83991-Populate-Table
Original by Oleg Fateev

Modified by hms 2014/11/14
as a 'demo' to JCprog
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extract-attributes-from-a-specific-block-and-write-to-table/m-p/5399759#U5399759
|;

(defun C:CLIST (/ a1 a2 a3 acapp acsp adoc atable attdata atts col headers pt row title)
(or adoc
   (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object))))
)
(or acsp
   (setq acsp (vla-get-block (vla-get-activelayout adoc)))
)

(vlax-for blk (vla-get-blocks adoc)
   (if (= (vla-get-IsXref blk) :vlax-true) ;<-***
   (vlax-for x blk
       (if (and (= (vla-get-ObjectName x) "AcDbBlockReference")
                (wcmatch (vla-get-EffectiveName x) "*|Duct")
         )
         (progn
         (setq atts (vlax-invoke x 'getattributes))
         (foreach att atts
             (cond ((wcmatch (vla-get-tagstring att) "DUCT_START")
                  (setq a1 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCT_END")
                  (setq a2 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCTTYPE")
                  (setq a3 (vla-get-textstring att))
                   )
             )
         )
         (setq attdata (cons (list a1 a2 a3) attdata))
         )
       )
   )

)
(if (setq pt (getpoint "\nSpecify table location:"))
   (progn
   (setq atable
            (vla-addtable
            acsp
            (vlax-3d-point pt)
            (+ 2 (length attdata))
            3
            (/ (getvar 'dimtxt) 2)
            (* (getvar 'dimtxt) 4)
            )
   )
   (vla-put-regeneratetablesuppressed atable :vlax-true)
   (setq col 0)
   (foreach wid (list 10.0 10.0)
       (vla-setcolumnwidth atable col wid)
       (setq col (1+ col))
   )
   (vla-put-horzcellmargin atable 0.3)
   (vla-put-vertcellmargin atable 0.3)
   (vla-setTextheight atable 1 2.0)
   (vla-setTextheight atable 2 1.4)
   (vla-setTextheight atable 4 1.4)
   (setq title "DUCTS")
   (vla-setText atable 0 0 title)
   (vla-setcelltextheight atable 0 0 2.0)
   (vla-SetCellAlignment atable 0 0 acMiddleCenter)
   (setq headers (list "START" "END" "TYPE"))
   (setq row 1
         col 0
   )
   (repeat (length headers)
       (vla-SetCellAlignment atable row col acMiddleCenter)
       (vla-setcelltextheight atable row col 1.4)
       (vla-setText atable row col (car headers))
       (setq headers (cdr headers))
       (setq col (1+ col))
   )
   (setq row 2)
   (foreach record attdata
       (setq col 0)
       (foreach item record
         (vla-setText atable row col item)
         (vla-SetCellAlignment atable row col acMiddleCenter)
         (vla-setcelltextheight atable row col 1.4)
         (setq col (1+ col))
       )
       (setq row (1+ row))
   )
   (vla-put-regeneratetablesuppressed atable :vlax-false)
   (vla-put-height atable (+ (* (vla-get-rows atable) 2.2) 4.1))
   (vla-update atable)
   )
)
(princ)
)
(prompt "\n\t---\tStart command with CLIST\t---\n")
(prin1)
(or (vl-load-com))
(princ)

Dadgad 发表于 2022-7-5 17:17:49

你好
 
 
感谢您的输入，但我要做的更多的是从动态块中提取数据。

Spaj 发表于 2022-7-5 17:19:13

 
Spaj，请清楚解释一个块及其坐标，如表所示，以及何时添加减号或加号。

Tharwat 发表于 2022-7-5 17:22:10

嗨Tharwat
 
抱歉给你带来了困惑。附件是一个示例。简单地说，在AutoCAD中生成的余词需要进行转置，即X成为Y值，Y成为X值，但符号相反。
 
管道示例1。图纸
 
这是由于SA中的非标准测量坐标系是向南的，角度测量是逆时针的，坐标系引用Y然后X。AutoCAD中的最佳折衷方案是在第三象限笛卡尔坐标系中工作（其中X和Y值为-ve）。这允许正确的方向和坐标值的正确顺序，但缺点是这些值的符号不正确。因此，所有引用的同词都需要转置和签名。

Spaj 发表于 2022-7-5 17:27:50

你好
 
您可能知道如何消除逻辑来检查块是否为附加代码中的外部参照吗？
 

; dwg index to a table
; by Alan H NOV 2013
(defun AH:dwgindex (/ doc objtable ss1 lay ans ans2 plotabs ss1 tag2 tag3 list1 list2 curlayout colwidth numcolumns numrows INC rowheight )
(vl-load-com)
(setq curlayout (getvar "ctab"))
(if (= curlayout "Model")
(progn
(Alert "You need to be in a layout for this option")
(exit)
) ; end progn
) ; end if model
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-paperspace doc))
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table: ")))
; read values from title blocks
(setq bname "DA1DRTXT")
(setq tag2 "DRG_NO") ;attribute tag name
(setq tag3 "WORKS_DESCRIPTION") ;attribute tag name
(setq ss1 (ssget "x" (list (cons 0 "INSERT") (cons 2 bname))))
(if (= ss1 nil) ; for xxx jobs
(progn
(setq bname "XXXX_TITLE")
(setq ss1 (ssget "x" (list (cons 0 "INSERT") (cons 2 bname))))
)
)
(setq INC (sslength ss1))
(repeat INC
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (SETQ INC (- INC 1)) )) 'getattributes)
(if (= tag2 (strcase (vla-get-tagstring att)))
(progn
(setq ans (vla-get-textstring att))
(if (/= ans NIL)
(setq list1 (cons ans list1))
) ; if
); end progn
) ; end if
(if (= tag3 (strcase (vla-get-tagstring att)))
(progn
(setq ans2 (vla-get-textstring att))
(if (/= ans2 NIL)
(setq list2 (cons ans2 list2))
) ; end if
) ; end progn
) ; end if tag3

) ; end foreach
) ; end repeat
(setvar 'ctab curlayout)
(command "Zoom" "E")
(command "regen")

(reverse list1)
;(reverse list2)
; now do table
(setq numrows (+ 2 (sslength ss1)))
(setq numcolumns 2)
(setq rowheight 0.2)
(setq colwidth 150)
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "DRAWING REGISTER")
(vla-settext objtable 1 0 "DRAWING NUMBER")
(vla-settext objtable 1 1 "DRAWING TITLE")
(SETQ X 0)
(SETQ Y 2)
(REPEAT (sslength ss1)
(vla-settext objtable Y 0 (NTH X LIST1))
(vla-settext objtable Y 1 (NTH X LIST2))
(vla-setrowheight objtable y 7)
(SETQ X (+ X 1))
(SETQ Y (+ Y 1))
)
(vla-setcolumnwidth objtable 0 55)
(vla-setcolumnwidth objtable 1 170)
(command "_zoom" "e")
); end AH defun
(AH:dwgindex)
(princ)

BIGAL 发表于 2022-7-5 17:28:32

只要变量是局部的，or函数的用途是什么？

Spaj 发表于 2022-7-5 17:32:26

嗨，李
 
 
谢谢，成功了。我把注释去掉了if语句和相应的括号，但没有去掉管道！管道的意义是什么？
 
不幸的是，我现在有一个ActiveX服务器返回了一个错误：参数不是
代码其余部分中的可选项。

Tharwat 发表于 2022-7-5 17:35:26

你好，Marko
 
谢谢你的投入，但这似乎不起作用。例程无法识别指定的块。

Spaj 发表于 2022-7-5 17:38:01

 
包含管道字符的表格名称（即图层、块、线型等）是与外部参照相关的项目，管道左侧的内容等于从中派生的外部参照的名称。
 
 
你能发布你当前修改过的代码吗？

Spaj 发表于 2022-7-5 17:41:49

 
啊哈，如果你能理解这些细微差别，这会有所帮助。
 
 
当然
 
CList_管道。LSP

查看完整版本: 动态块提取到表