Lisp预览中的所有块

Grrr · 发表于 2022-7-5 17:37:46

大家好，
我正在编写这段代码以预览图形中的所有块，但有一个问题我无法解决：
我需要从每个块中获取边界框，并比较它们的高度（Y坐标）。
然后插入每个块，使用极函数-类似于：

(setq newBspt (polar prevBspt (DtR 270.0) max-Y) )

工作完成了一半，似乎我无法从“Bobj”那里获得边界框：

copy

(defun C:test ( / pt att BlockLst Bname Bent Bobj)
(if
        (setq pt (getpoint "\nPick insertion point"))
        (progn
                (setq att (getvar 'attreq))
                (setq BlockLst (tblnext "BLOCK" T))
                (while BlockLst
                        (setq Bname (cdr (assoc 2 BlockLst)))
                        (setq Bent (tblobjname "block" bname))
                        (setq Bobj (vlax-ename->vla-object Bent))
                        (setvar 'attreq 0)
                        (vl-cmdf "_.-insert" Bname "_S" 1.0 "_R" 0.0 "_non" pt "")
                        (setvar 'attreq att)
                        (setq BlockLst (tblnext "BLOCK"))
                )
        );progn
);if
(princ)
)

有什么想法吗？
编辑：
我附上了一个样本图纸：样本黑色预览。dwg，显示结果和所需内容。
编辑：
这张图更适合测试：树pln。图纸

Grrr · 发表于 2022-7-5 17:49:10

下面是一些快速而肮脏的代码，但它完成了任务：

copy

; PREVIEW BLOCKS in the drawing
(defun C:test ( / pt att BlockLst Bname Bent Bobj SS ent vla-obj bbox mnPt mxPt currentY maxY blkcnt )
(setvar 'CMDECHO 0)
(if
        (setq pt (getpoint "\nPick insertion point"))
        (progn
                (setq att (getvar 'attreq))
                (setq BlockLst (tblnext "BLOCK" T)) ; check all blocks in the drawing and insert them on "pt"
                (while BlockLst
                        (if
                                (and
                                        (setq Bname (cdr (assoc 2 BlockLst)))
                                        (setq Bent (tblobjname "block" bname))
                                        (setq Bobj (vlax-ename->vla-object Bent))
                                )
                                (progn
                                        (setvar 'attreq 0)
                                        (vl-cmdf "_.-insert" Bname "_S" 1.0 "_R" 0.0 "_non" pt )
                                        (setvar 'attreq att)
                                )
                        )
                        (setq BlockLst (tblnext "BLOCK"))
                )
                (if
                        (setq SS (ssget "_C" pt pt '((0 . "INSERT")))) ; manually select all the inserted blocks
                        (progn
                                (defun DtR (d) ( * PI (/ d 180.0)))
                                (setq maxY 0)
                                (repeat (setq i (sslength SS)) ; iterate trought selection to find maxY
                                        (setq ent (ssname SS (setq i (1- i)))) ; current entity
                                        (setq vla-obj (vlax-ename->vla-object ent))
                                        (setq bbox (vla-getboundingbox vla-obj 'mn 'mx))
                                        (setq mnPt (trans (vlax-safearray->list mn) 0 1) )
                                        (setq mxPt (trans (vlax-safearray->list mx) 0 1) )
                                        (setq currentY (- (cadr mxPt) (cadr mnPt)))
                                        (if (> currentY maxY) (setq maxY currentY))
                                );repeat
                                (princ maxY) ; Found maxY
                                
                                (command "_.erase" SS "") ; erase all inserted blocks
                                (setq blkcnt 0)
                                (setq BlockLst (tblnext "BLOCK" T)) ; check all blocks in the drawing and insert them on "pt" with incremented polar function
                                (while BlockLst
                                        (setq blkcnt (+ blkcnt 1))
                                        (if
                                                (and
                                                        (setq Bname (cdr (assoc 2 BlockLst)))
                                                        (setq Bent (tblobjname "block" bname))
                                                        (setq Bobj (vlax-ename->vla-object Bent))
                                                )
                                                (progn
                                                        (setvar 'attreq 0)
                                                        (vl-cmdf "_.-insert" Bname "_S" 1.0 "_R" 0.0 "_non" (if (= blkcnt 1) pt (setq pt (polar pt (DtR 270.0) maxY))) ) 
                                                        (setvar 'attreq att)
                                                )
                                        )
                                        (setq BlockLst (tblnext "BLOCK"))
                                )
                        ); progn
                ) ; if
                
        ); progn
);if
(princ)
)

我想不出还有什么。

Lee Mac · 发表于 2022-7-5 17:58:45

你的方法是合理的-另一种方法是迭代构成块定义的对象，并在插入每个块之前计算块定义的边界框，但你的方法同样有效（不过，你会收到动态块的意外结果-我在这里发布了一个更精确的函数来计算沼泽处块的边界框[你需要等到沼泽恢复后才能查看]）。

以下是编写程序的另一种方法，供您参考：

copy

(defun c:bprev ( / bpt cnt doc idx llp lst obj spc urp vec )
   (if (setq bpt (getpoint "\nSpecify insertion point: "))
       (progn
           (setq doc (vla-get-activedocument (vlax-get-acad-object))
                 spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                 bpt (trans bpt 1 0)
           )
           (vlax-for blk (vla-get-blocks doc)
               (if (and (= :vlax-false (vla-get-islayout blk))
                        (= :vlax-false (vla-get-isxref   blk))
                        (not (wcmatch  (vla-get-name blk) "`**,`_*,*|*"))
                   )
                   (progn
                       (setq obj (vlax-invoke spc 'insertblock bpt (vla-get-name blk) 1.0 1.0 1.0 0.0))
                       (vla-getboundingbox obj 'llp 'urp)
                       (setq idx (cons (cadr (mapcar '- (vlax-safearray->list urp) (vlax-safearray->list llp))) idx)
                             lst (cons obj lst)
                       )
                   )
               )
           )
           (setq vec  (list 0.0 (- (apply 'max idx)) 0.0)
                 cnt '(0 0 0) 
           )
           (foreach idx (vl-sort-i idx '>)
               (vlax-invoke (nth idx lst) 'move '(0.0 0.0 0.0) (mapcar '* vec cnt))
               (setq cnt (mapcar '1+ cnt))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Grrr · 发表于 2022-7-5 18:04:58

你好，李，
你的代码是完美的。
我想知道这到底是怎么做到的，因为我试图通过将表对象转换为vla对象来获取边界框，并以这种方式获取边界框-但我遇到了一个错误。

copy

  (if (and (= :vlax-false (vla-get-islayout blk))
                        (= :vlax-false (vla-get-isxref   blk))
                        (not (wcmatch  (vla-get-name blk) "`**,`_*,*|*"))
                   )

我再一次看到了这些我从未想过的细节。

我同意我的代码非常完善，它代表了我有限的lisp知识。
我将尝试分析您的代码中发生了什么，尽管它看起来非常复杂，即使我认为自己是一个中等技能的lisper。
再次感谢您！