选择嵌套属性tex
大家好，我需要帮助选择嵌套对象，该对象是块中的属性文本，以便能够删除其上的图案填充。下面是我目前正在使用的代码（不是我最初使用的代码，我为我的应用程序对其进行了一些调整）。这段代码只适用于整个块，但不允许我只选择文本。
(defun Fixhatch (/ Hatchfix objct)
(while
(setq Hatchfix (entsel "\nSelect Hatch to fix (or Enter to close):"))
(redraw (car Hatchfix) 3)
(Alert "\n***Select object(s) to clear/skip hatch:***")
(setq objct (ssget))
(if (eq (cdr (assoc 0 (entget (setq Hatchfix (car Hatchfix))))) "HATCH")
(command "_.-hatchedit" Hatchfix "Ad" "s" objct "" "")
(princ "\nSelected entity is not a hatch.")
);end if
);end while
);end defun
如您所见，文本TB6是矩形块的属性文本，我只想从文本中删除图案填充。
这能做到吗？
提前谢谢。
(defun c:Test (/ s)
;; Tharwat 21.10.2013 ;;
(or Doc
(setq Doc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(while
(and (setq s (car (nentsel "\n Select Hatch in Block to delete :")))
(eq (cdr (assoc 0 (entget s))) "HATCH")
)
(vl-catch-all-apply
'vla-delete
(list (vlax-ename->vla-object s))
)
(vla-regen Doc AcAllViewports)
)
(princ)
)
(vl-load-com) 据我所知，即使将属性子图元提供给HATCHEDIT命令（使用ENTSEL选择），该命令也将仅处理主块参照图元，从而在块周围创建图案填充边界。
嗨，塔瓦，
我试着使用你的代码，但它只是删除了图案填充。这不是我的本意。也许我解释得不好。
下图显示了我的lisp版本“不正确”。如果我能得到“正确”的版本，使图案填充只跳过属性文本（而不是整个块）。
我看到了Lee使用nentsel所说的内容，但仅限于选择上层实体（即块）。
有办法吗？ 舱口是块的一部分吗？还是一个单独的实体？
图案填充是一个单独的实体。它是由一个lisp实用程序添加的，该实用程序一次将hatch添加到多个云。 下面是我将如何解决这个问题：
选择属性实体
复制选定的嵌套实体
创建与属性属性匹配的文本
运行你的FIXHATCH东西
删除图案填充的关联特性
删除复制的文本字符串
编辑：一次成功。
谢谢pBe的建议。
但这正是我到目前为止一直在做的工作。但这需要做更多的工作。
我在想AutoLISP可能有不同的方法来解决这个问题。此外，删除图案填充不仅限于文本。有时，我还必须从块中选择除文本实体之外的其他实体。
嗯，不是真的shailujp，等等，我将为属性编写一个简短的代码。。。
编辑：针对多选和选定图元类型进行修改
(defun c:HIH (/ _tempE hat ob a2t atb prop atb hat holes ); Hole in Hatch
(defun _tempE (ne / tmp)
(setq tmp (entmakex (entget (car ne))))
(vla-transformby
(vlax-ename->vla-object tmp)
(vlax-tmatrix (caddr ne))
)
tmp
)
;;; Borrowed from LM ;;;
;;; mod from /= to wcmatch ;;;
(defun _selectobject ( msg obj fun / sel )
(while
(progn (setvar 'errno 0) (setq sel (car (setq itm ((eval fun) msg))))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type sel))
(if (not (wcmatch(cdr (assoc 0 (entget sel))) obj))
(princ "\nInvalid object selected.")
)
)
)
)
)
itm
)
;;; ;;;
(if(setq holes (ssadd) hat (_selectobject "\nSelect Hatch: " "HATCH"'entsel))
(progn
(redraw (car hat) 3)
(while
(Setq ob (_selectobject "\nSelect objects to exclude hatch: " "ATTRIB,*LINE,*TEXT,CIRCLE" 'nentselp))
(ssadd
(if (eq (cdr (assoc 0 (entget (car ob)))) "ATTRIB")
(progn
(setq a2t (vlax-ename->vla-object (car ob)))
(Setq prop (mapcar '(lambda (p)
(vlax-get a2t p)
)
'("Insertionpoint" "Textstring" "Height")))
(setqatb (vlax-invoke
(vlax-get (vla-get-ActiveLayout
(vla-get-activedocument (vlax-get-acad-object))
) 'Block ) 'AddText
(cadr prop)
(car prop)
(caddr prop)
)
)(vlax-vla-object->ename atb)
)
(_tempE ob)
) Holes)
(redraw (ssname holes (1- (sslength holes))) 3)
)
(command "_.-hatchedit" (setq hat (Car hat)) "Ad" "s" holes "" "")
(vla-put-AssociativeHatch (vlax-ename->vla-object hat) :vlax-false)
(command "_.erase" holes "")
)
)(princ)
)
编辑：针对多个选择进行修改 好主意pBe-跳出框框思考
以下是我对您想法的实现，使用我的Burst升级程序中的函数：
(defun c:fixhatch ( / _selectobject att hat obj txt )
(defun _selectobject ( msg obj fun / sel )
(while
(progn (setvar 'errno 0) (setq sel (car ((eval fun) msg)))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type sel))
(if (/= obj (cdr (assoc 0 (entget sel))))
(princ "\nInvalid object selected.")
)
)
)
)
)
sel
)
(if
(and
(setq hat (_selectobject "\nSelect Hatch: " "HATCH"'entsel))
(setq att (_selectobject "\nSelect Attribute: " "ATTRIB" 'nentsel))
(setq obj (vlax-ename->vla-object att))
)
(if (setq txt
(if (and (vlax-property-available-p obj 'mtextattribute) (= :vlax-true (vla-get-mtextattribute obj)))
(iburst:matt2mtext (entget att))
(iburst:att2text (entget att))
)
)
(progn
(command "_.-hatchedit" hat "_DI" "_.-hatchedit" hat "_AD" "_S" txt "" "")
(entdel txt)
)
(princ "\nUnable to convert attribute to text.")
)
)
(princ)
)
;; The following functions are taken from Burst Upgraded:
;; http://lee-mac.com/upgradedburst.html
(defun iburst:removepairs ( itm lst )
(vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)
(defun iburst:remove1stpairs ( itm lst )
(vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
(defun iburst:att2text ( enx )
(entmakex
(append '((0 . "TEXT"))
(iburst:removepairs '(000 002 070 074 100 280)
(subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
)
)
)
)
(defun iburst:matt2mtext ( enx )
(entmakex
(append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
(iburst:remove1stpairs'(001 007 010 011 040 041 050 071 072 073 210)
(iburst:removepairs '(000 002 042 043 051 070 074 100 101 102 280 330 360) enx)
)
)
)
)
(vl-load-com) (princ)
页:
[1]
2