[LISP程序]：关于块内实体

wsfree · 发表于 2006-7-4 10:08:04

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

有一个块内由一个PLINE和一个TEXT组成,要在没有炸开块的情况下
能修改PLINE和修改TEXT,请高手指点一下

ysx810210 · 发表于 2006-7-6 13:40:59

试试这个
命令: (block-get-allztylist (cdr (assoc 2 (entget (car (entsel))))))
选择对象: (<图元名: 7eddcf18> <图元名: 7eddcf10> <图元名: 7eddcf08> <图元名:
7eddcee0> <图元名: 7eddced8> <图元名: 7eddced0> <图元名: 7eddcec8> <图元名:
7eddcec0> <图元名: 7eddceb8> <图元名: 7eddceb0> <图元名: 7eddcea8> <图元名:
7eddcea0> <图元名: 7eddce98> <图元名: 7eddce90> <图元名: 7eddce88>)

zzt21963 · 发表于 2006-10-3 20:26:48

很喜欢楼上编的程序

Archli · 发表于 2007-4-20 16:13:39

下来学习一下，不知道有没有人知道vlisp中怎么写

xjlong547 · 发表于 2008-12-7 21:27:05

最近也正在想办法改块内的实体

eachy · 发表于 2008-12-8 08:39:00

最初由 xjlong547 发布
[B]最近也正在想办法改块内的实体 [/B]

;;循环点选改块内实体示例 author: eachy , 2008.12.8
(defun c:t1 (/ e ss ssl i )
(while (and (setq e (nentsel "\nPick Insert: "))
(= (length e) 4)
);_保证点选为块内实体
(vla-put-color (vlax-ename->vla-object (car e)) acred);_修改颜色
(if (setq ss (ssget "x" (list (assoc 2 (entget (last (last e)))))))
(progn
(setq ssl (sslength ss)
i -1
)
(repeat ssl
(entupd (ssname ss (setq i (1+ i))))
);_更新图中所有Insert
)
)
)
(princ)
)

;;最后的表内可能有重复实体
(defun AllEntityInBlkdef (blk / bn blkdef e typ el )
(setq bn (cdr (assoc 2 (entget blk)))
blkdef (tblobjname "block" bn)
)
(while (setq e (entnext blkdef))
(setq typ (cdr (assoc 0 (entget e))))
(if (= typ "INSERT")
(setq el (append (ybl-blk-listent e) el))
(setq el (cons e el))
)
(setq blkdef e)
)
el
)

kingqian83 · 发表于 2008-12-8 09:03:19

学习中，谢谢前辈

中原渔人 · 发表于 2008-12-12 15:19:33

呵呵。。。感觉这东西不错。。要是能随意修改块里的东西，那就爽了。。

taner · 发表于 2008-12-13 07:49:43

[FONT=courier new]
(defun th-subelst-blk (blkname / blk lst)
(setq blk (vla-item (th-doccollection 'blocks) blkname))
(vlax-for each blk (if (/= (vla-get-objectname each) "AcDbBlockReference")
(setq lst (cons each lst))
(setq lst (append
(th-subelst-blk (vla-get-name each))
lst
)
)
)
)
lst
)
(defun hao-subelst-blk (ename / elst)
(if (and
ename
(setq elst (entget ename))
)
(if (= "BLOCK" (cdr (assoc 0 elst)))
(hao-subelst-blk (th-get-dxf -2 (tblsearch "BLOCK"
(th-get-dxf 2 elst)
)
)
)
(if (= "INSERT" (cdr (assoc 0 elst)))
(append
(hao-subelst-blk (th-get-dxf -2 (tblsearch "BLOCK"
(th-get-dxf 2 elst)
)
)
)
(hao-subelst-blk (entnext ename))
)
(cons ename (hao-subelst-blk (entnext ename)))
)
)
)
)
(defun t2-subelst-blk (blkname)
(hao-subelst-blk (tblobjname "BLOCK" blkname))
)
(defun th-get-dxf (g e)
(cond
((= 'ename (type e))
(cdr (assoc g (entget e)))
)
((= 'list (type e))
(cdr (assoc g e))
)
)
)
[/FONT]

[FONT=courier new] 
(defun th-subelst-blk (blkname / blk lst) 
  (setq blk (vla-item (th-doccollection 'blocks) blkname)) 
  (vlax-for each blk (if (/= (vla-get-objectname each) "AcDbBlockReference") 
                       (setq lst (cons each lst)) 
                       (setq lst (append 
                                   (th-subelst-blk (vla-get-name each)) 
                                   lst 
                                 ) 
                       ) 
                     ) 
  ) 
  lst 
) 
(defun hao-subelst-blk (ename / elst) 
  (if (and 
        ename 
        (setq elst (entget ename)) 
      ) 
    (if (= "BLOCK" (cdr (assoc 0 elst))) 
      (hao-subelst-blk (th-get-dxf -2 (tblsearch "BLOCK" 
                                                 (th-get-dxf 2 elst) 
                                      ) 
                       ) 
      ) 
      (if (= "INSERT" (cdr (assoc 0 elst))) 
        (append 
          (hao-subelst-blk (th-get-dxf -2 (tblsearch "BLOCK" 
                                                     (th-get-dxf 2 elst) 
                                          ) 
                           ) 
          ) 
          (hao-subelst-blk (entnext ename)) 
        ) 
        (cons ename (hao-subelst-blk (entnext ename))) 
      ) 
    ) 
  ) 
) 
(defun t2-subelst-blk (blkname) 
  (hao-subelst-blk (tblobjname "BLOCK" blkname)) 
) 
(defun th-get-dxf (g e) 
  (cond 
    ((= 'ename (type e)) 
      (cdr (assoc g (entget e))) 
    ) 
    ((= 'list (type e)) 
      (cdr (assoc g e)) 
    ) 
  ) 
) 
  [/FONT]

块内实体列表有了，改其特性就不难了。

jx2008 · 发表于 2009-1-8 23:33:42

6楼程序缺少（ybl-blk-listent）函数；9楼程序缺少函数（th-doccollection）。希望能补全！

taner · 发表于 2009-1-9 08:04:32

[FONT=courier new]
(defun th-doccollection (typename)
(vlax-get-property (thactdoc) typename)
)
(defun thactdoc ()
(cond
(%$*thactdoc*$%)
(setq %$*thactdoc*$% (vla-get-activedocument (thacadobj)))
)
)
(defun thacadobj ()
(cond
(%$*thacadobj*$%)
(setq %$*thacadobj*$% (vlax-get-acad-object))
)
)
[/FONT]

daidong013 · 发表于 2009-1-9 13:12:46

下不来嘛！~~九楼的命令呢？！~~

eachy · 发表于 2009-1-9 14:46:11

最初由 jx2008 发布
[B]6楼程序缺少（ybl-blk-listent）函数；9楼程序缺少函数（th-doccollection）。希望能补全！ [/B]

ybl-blk-listent -〉AllEntityInBlkdef

xdto · 发表于 2009-1-10 09:20:33

如果是嵌套块呢?

jx2008 · 发表于 2009-1-23 13:54:19

有什么方法可以单独亮显块内的实体？

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：关于块内实体

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子