960322 发表于 2024-5-17 00:32:52

已有嵌套块中的块层级表，请问如何按各路径展开

现在已经得到了嵌套块中的块层级表，请问如何按各路径展开得到所有的嵌套块组成情况
;;;;得到多重嵌套块的嵌套层级表
;;;;blk，任意图块的图块名
(defun getblklst (blk / e dxf lst blk2)
   (setq e(tblobjname "block" blk)
lstnil)
      (while(setq e(entnext e)    )            ;;;;;(setq e(entnext e) nam (zm e 2)   )            
               (and(setq dxf(entget e))                              
                         (wcmatch(cdr(assoc 0 dxf)) "INSERT")
                         (setq blk2(cdr(assoc 2 dxf)))      
                         (setq lst1 (list(list   (list blk2) (getblks blk2))   ))
         (setq lst (append lst1 lst))                        
               )
         )lst
)
(getblklst"9")
;;((("8") ((("6") ((("5") nil) (("4") nil))) (("3") ((("2") nil) (("1") nil))))) (("7") ((("6") ((("5") nil) (("4") nil))) (("3") ((("2") nil) (("1") nil))))))

vitalgg 发表于 2024-5-17 10:36:38

本帖最后由 vitalgg 于 2024-5-17 11:55 编辑

http://s1.atlisp.cn/static/videos/blk-in-loop.mp4


(defun blk-in-loop (blkref / res)
"块嵌套表"
(setq res nil)
(if (eq "INSERT" (entity:getdxf blkref 0))
      (progn
(setq res (cons blkref res))
(if (setq subblks (vl-remove-if-not
         '(lambda(x)(eq "INSERT" (entity:getdxf x 0)))
         (block:ent-list (entity:getdxf blkref 2))))
      (setq res (cons (mapcar 'blk-in-loop subblks) res)))))
(reverse res))

(defun blkbase-in-loop (lst-blkloop para1 / res subblks tmp-para)
"基点坐标嵌套表,para1为基点，旋转角，缩放比例，默认为((0 0)0 1)"
(if (null para1)
      (setq para1 '((0 0 0) 0 1.0)))
(setq res nil)
(if (eq "INSERT" (entity:getdxf (car lst-blkloop) 0))
      (progn
(setq res (cons
       (list
      (block:bcs2wcs
         (entity:getdxf (car lst-blkloop) 10)
         (entity:getdxf
          (tblobjname "block" (entity:getdxf (car lst-blkloop) 2))
          10)
         (car para1)
         (cadr para1)
         (caddr para1)
         )
      (+(cadr para1)
      (entity:getdxf (car lst-blkloop) 50))
      
      (* (entity:getdxf (car lst-blkloop) 41)
         (caddr para1))
      )
       res))
(entity:putdxf
   (entity:make-circle (caar res) 2)
   62 1)
(if (setq subblks (cadr lst-blkloop))
      (progn
      (setq tmp-para (car res))
      (setq res (cons (mapcar '(lambda(x)
          (blkbase-in-loop
         x
         tmp-para))
            subblks)
            res))))))
(reverse res))

(setq blkref(car(entsel)))
(blkbase-in-loop(blk-in-loop blkref)nil)



以上代码由 @lisp函数库 提供支持！https://atlisp.cn/functionlib.html
请先运行以下代码，再执行上面的代码。
(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))


960322 发表于 2024-5-17 20:37:23

楼上的高手，我确实是想得到每个图块的实际插入点:lol，可惜水平太差做不到。就想先一步一步的来了。请问您的程序是不是需要联网用你的程序库才行？

kozmosovia 发表于 2024-5-17 21:21:33

要得到插入点，不用矩阵转换的方式就是把主图快copy原点到DBX中分解，然后顺次分解得到需要图块名的快插入点。

960322 发表于 2024-5-18 00:02:14

vitalgg 发表于 2024-5-17 10:36
以上代码由 @lisp函数库 提供支持！https://atlisp.cn/functionlib.html
请先运行以下代码 ...

感谢老大，自己摸索着把你的函数补齐了，搞定了，谢谢！

Pegasus 发表于 2024-5-28 21:48:13

本帖最后由 Pegasus 于 2024-5-28 21:49 编辑

960322 发表于 2024-5-18 00:02
感谢老大，自己摸索着把你的函数补齐了，搞定了，谢谢！
差 "@:log" 和 "TYPE-OF" 这两个函数，能提供代码吗？

xshrimp 发表于 2024-5-30 12:14:38

本帖最后由 xshrimp 于 2024-5-30 12:21 编辑

不知道你要什么?

(xzj-blk-tree "9")
=>(defun xzj-blk-tree (blkName / i lst)   
   (setq lst (append lst(list blkName)))
   (vlax-for i (vla-item(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))blkName)   
    (if (= "AcDbBlockReference" (vla-get-ObjectName i))
      (setq lst (append lst (list (append (xzj-blk-tree (vla-get-Name i)) ))))
    )      
   )
lst
)

("9"
("7"
    ("3" ("1") ("2"))
    ("6" ("4") ("5"))
)
("8"
    ("3" ("1") ("2"))
    ("6" ("4") ("5"))
)
)


页: [1]
查看完整版本: 已有嵌套块中的块层级表，请问如何按各路径展开