提取块中块的问题

mjthetuxedo

请问在图形中有多个图块~~其中有些图块里还有图块~~（不止两层，某些图块里还包含有图块）
比如：一个图块由两个或以上图块组成~~而这两个或以上图块中又包含有图块~~
不知能否把这些图块中包含的指定图形（如圆形的圆心）提取出来

ZZXXQQ

当然可以。本论坛有许多类似程序。先搜索下看看。

qjcpj

编个函数，使用递归...

caoyin

;;帮你写一个，试试看，提取多重套嵌块中圆的圆心

(defun c:test (/ blkfor en blks lst)
  (defun blkfor (blks obj / ins bn ty p lst)
    (setq ins (vla-get-InsertionPoint obj)
          ins (vlax-safearray->list (vlax-variant-value ins))
          bn  (vla-get-name obj)
    )
    (vlax-for ent (vla-item blks bn)
      (setq ty (vla-get-objectname ent))
      (cond ((= ty "AcDbCircle")
             (setq p   (vla-get-Center ent)
                   p   (vlax-safearray->list (vlax-variant-value p))
                   lst (cons (mapcar '+ ins p) lst)
             )
            )
            ((= ty "AcDbBlockReference")
             (setq lst (append lst
                               (mapcar '(lambda (p) (mapcar '+ ins p))
                                       (blkfor blks ent)
                               )
                       )
             )
            )
      )
    )
    lst
  )
  (if (setq en (entsel "\n选择块: "))
    (progn
      (setq blks (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))))
      (blkfor blks (vlax-ename->vla-object (car en)))
    )
  )
)

mjthetuxedo

楼上的谢了~！！！
用着不错~！！不知不用VL函数能不能实现这样的功能

(setq blks (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))))
的意思是返回当前选择的图块里的所有子图块吗？？？
如果是用选择集的话返回的是？？？？？？

caoyin

(setq blks (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))))
的意思是返回当前选择的图块里的所有子图块吗？？？
如果是用选择集的话返回的是？？？？？？

;;返回当前文档的所有块定义的VLA集合，跟选择集没有关系

caoyin

不用vla函数，用 entnext 也可以实现

mjthetuxedo

(defun c:zh (/ s s_ent ent s1 tkm pins zty xh wzg)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setq s (ssget '((0 . "insert"))))
  (setq xh (getint "输入起始序号<1>："))
  (if (null xh)(setq xh 1))
  (setq wzg (getdist "输入文字高度<400>："))
  (if (null wzg)(setq wzg 400))
  (repeat (setq s1 (sslength s))
    (setq s_ent (ssname s (setq s1 (1- s1))))
    (setq ent (entget s_ent))
    (setq tkm (cdr (assoc 2 ent)))
    (setq pins (cdr (assoc 10 ent)))
    (zh_a tkm pins)
  )
  (setvar "cmdecho" 1)
  (setvar "osmode" 5)
)

(defun zh_a(tkm1 pins1 / yx bj pins z_ent tkm)
  (setq z_ent (entget (cdr (assoc -2 (tblsearch "block" tkm1)))))
  (if (= (cdr (assoc 0 z_ent)) "circle")
    (progn
      (setq yx (cdr (assoc 10 z_ent)))
      (setq bj (cdr (assoc 40 z_ent)))
      (setq yx (mapcar '+ pins1 yx))
      (command ".text" "tl" (polar (polar yx 0 bj) (/ pi -2) bj) wzg 0 (itoa xh))
      (setq xh (1+ xh))
    )
  )
  (if (= (cdr (assoc 0 z_ent)) "insert")
    (progn
      (setq tkm (cdr (assoc 2 z_ent)))
      (setq pins (mapcar '+ pins1 (cdr (assoc 10 Z_ent))))
      (setq zty (cdr (assoc -2 (tblsearch "block" tkm))))
      (zh_a tkm pins)
      )
    ))

高手帮忙看一下~！！！哪里出问题了~~

caoyin

大概看了一下

(if (= (cdr (assoc 0 z_ent)) "circle")...

(if (= (cdr (assoc 0 z_ent)) "insert")...

红色应为大写