Lisp预览中的所有块
大家好，我正在编写这段代码以预览图形中的所有块，但有一个问题我无法解决：
我需要从每个块中获取边界框，并比较它们的高度（Y坐标）。
然后插入每个块，使用极函数-类似于：
(setq newBspt (polar prevBspt (DtR 270.0) max-Y) )
工作完成了一半，似乎我无法从“Bobj”那里获得边界框：
(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。图纸 下面是一些快速而肮脏的代码，但它完成了任务：
; 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)
)
我想不出还有什么。 你的方法是合理的-另一种方法是迭代构成块定义的对象，并在插入每个块之前计算块定义的边界框，但你的方法同样有效（不过，你会收到动态块的意外结果-我在这里发布了一个更精确的函数来计算沼泽处块的边界框[你需要等到沼泽恢复后才能查看]）。
以下是编写程序的另一种方法，供您参考：
(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) 你好，李，
你的代码是完美的。
我想知道这到底是怎么做到的，因为我试图通过将表对象转换为vla对象来获取边界框，并以这种方式获取边界框-但我遇到了一个错误。
(if (and (= :vlax-false (vla-get-islayout blk))
(= :vlax-false (vla-get-isxref blk))
(not (wcmatch(vla-get-name blk) "`**,`_*,*|*"))
)
我再一次看到了这些我从未想过的细节。
我同意我的代码非常完善，它代表了我有限的lisp知识。
我将尝试分析您的代码中发生了什么，尽管它看起来非常复杂，即使我认为自己是一个中等技能的lisper。
再次感谢您！
谢谢你，Grrr。
我在沼泽的代码（我在上面提供了一个链接）给出了一个完整的例子，说明了如何做到这一点（沼泽应该随时恢复在线！）。
不客气-如果您对发布的代码有任何进一步的问题，请随时询问。
李 打开设计中心，打开绘图选项卡，双击块，完成。
第二个！
我在宏中使用adcnavigate命令打开带有街道标志块的MUTCD图形中的设计中心。
节省时间。 谢谢大家的建议！
但我实际上想在模型空间中插入图形中的所有块，以便于比较和用于其他目的。
第二个原因是编码部分（代码工作所需的方法并不常见），因此LM向我们展示了一些新的学习方法。
抱歉误解了，有时候我很难解释我想要达到的目标。
没问题，我是李代码的超级粉丝。任何时候我都可以访问他的网站。提供选项以防万一。
页:
[1]