高亮显示选定内容
我有下面的Lisp程序。运行代码时，它首先要求选择维度，然后要求选择属性块以导入维度的值。我的问题是：-如何修改代码以使选定尺寸高亮显示，如标准AutoCAD选择高亮显示？目前，选定的维度未高亮显示，因此很难知道它是否被选中。我希望这是一个简单的解决方案，有人可以帮助我。
这可能更复杂，但我想知道是否可以修改代码，使其能够将维度文本放置在任何指定的属性标记中。现在，它只将维度文本放置在具有多个标记的属性的第一行。
在这种特殊情况下，代码中指定了标记名“UTUNIT”，但仅当“UTUNIT”位于属性的第一行时才起作用。
(defun C:dimatt (/ dim diminfo dimtext ss ent entinfo)
(setq dim (entsel "\n Select Dimension: "))
(setq diminfo (entget (car dim)))
(if (= (cdr (assoc 1 diminfo)) "")
(setq dimtext (rtos (cdr (assoc 42 diminfo))))
(setq dimtext (cdr (assoc 1 entinfo)))
)
(setq ss (ssget))
(setq ent (entnext (ssname ss 0)))
(setq entinfo (entget ent))
(while
(and ent
(= (cdr (assoc 0 entinfo)) "ATTRIB")
)
(if (= (cdr (assoc 2 entinfo)) (strcase "UTUNIT"))
(progn
(entmod (subst (cons 1 dimtext) (assoc 1 entinfo) entinfo))
(entupd ent)
(setq ent nil)
)
(setq ent (entnext ent))
)
)
(princ)
)
谢谢任何能帮忙的人。 解决方案是重画函数：
(redraw ent 3) ;highlight
...
(redraw ent 4) ;un-highlight
当做
米尔恰 米尔恰，
谢谢你的回复。
请原谅我的无知和lisp知识的缺乏，但这将在代码中插入到哪里？ 我最近刚刚用redraw函数写了一个
样品 您可以这样添加：
(defun C:dimatt ( / dim diminfo dimtext ss ent entinfo)
(setq dim (entsel "\n Select Dimension: "))
(redraw (car dim) 3)
(setq diminfo (entget (car dim)))
(if (= (cdr (assoc 1 diminfo)) "")
(setq dimtext (rtos (cdr (assoc 42 diminfo))))
(setq dimtext (cdr (assoc 1 entinfo)))
)
(prompt "\nSelect block to export value:")
(setq ss (ssget))
(setq ent (entnext (ssname ss 0)))
(setq entinfo (entget ent))
(while
(and ent
(= (cdr (assoc 0 entinfo)) "ATTRIB")
)
(if (= (cdr (assoc 2 entinfo)) (strcase "UTUNIT"))
(progn
(entmod (subst (cons 1 dimtext) (assoc 1 entinfo) entinfo))
(entupd ent)
(setq ent nil)
)
(setq ent (entnext ent))
)
)
(redraw (car dim) 4)
(princ)
)
当做
米尔恰
考虑一下[快速书写]
(defun c:test( / atsel dim str atb e b)
(vl-load-com)
(setq atsel (ssadd))
(if (and
(setq dim (ssget ":S:E" '((0 . "DIMENSION"))))
(setq str (rtos (vla-get-measurement
(setq e (vlax-ename->vla-object
(ssname dim
0))))))
(not (vla-Highlight e :vlax-true))
)
(progn
(while (setq atb(nentselp
"\nSelect Attribute value to replace: "))
(if (eq (cdr (assoc 0 (entget (setq at (Car atb))))) "ATTRIB")
(progn (ssadd at atsel)(redraw at 3))
)
)
(repeat (Setq i (sslength atsel))
(vla-put-textstring
(vlax-ename->vla-object
(setq b (ssname atsel
(setq i (1- i)))))
str)
(redraw b 4)
)
(vla-Highlight e :vlax-false)
)
)(princ)
)
HTH公司 Mircea，非常感谢修改后的代码。我试过了，效果很好。我希望我能抽出时间学习推理。
我感谢你的时间和帮助。
pBe。。。。。。
我能说什么？你的代码远远优于我使用的原始代码。
你已经不是第一次把我要求的一切都给了我了。
衷心感谢。
如果你们在马尼拉，请联系我。啤酒我请客。
完全欢迎你！
当做
米尔恰
真的没什么，我只是做了个普通的
也许有一天我会接受你的提议
这是我的版本，使用一个字段：
;; Link Dimension to Attribute-Lee Mac
;; Prompts for selection of a Dimension and references the Dimension
;; value using a Field located in a selected block attribute.
(defun c:Dim2Att ( / *error* ad at el en g1 g2 gr ms ob p1 st )
(defun *error* ( msg )
(if en (redraw en 4))
(if ad (vla-endundomark ad))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(redraw) (princ)
)
(while
(progn (setvar 'ERRNO 0) (setq en (car (entsel "\nSelect Dimension to Link: ")))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, try again.")
)
( (eq 'ENAME (type en))
(if (not (wcmatch (cdr (assoc 0 (entget en))) "*DIMENSION"))
(princ "\nObject is not a Dimension.")
)
)
)
)
)
(if en
(progn
(setq ad (vla-get-activedocument (vlax-get-acad-object))
el (entget en)
p1 (trans (cdr (assoc 11 el)) en 1)
ob (vlax-ename->vla-object en)
st (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p (vla-get-utility ad) 'getobjectidstring)
)
(vla-getobjectidstring (vla-get-utility ad) ob :vlax-false)
(itoa (vla-get-objectid ob))
)
(if (eq "" (cdr (assoc 1 el)))
">%).Measurement \\f \"%lu6\">%"
">%).TextOverride>%"
)
)
)
(vla-startundomark ad)
(redraw en 3)
(princ (setq ms "\nSelect Attribute to Link to Dimension: "))
(while
(progn
(setq gr (grread t 13 2)
g1 (cargr)
g2 (cadr gr)
)
(cond
( (= 5 g1)
(redraw)
(grdraw p1 g2 3 1)
t
)
( (= 3 g1)
(redraw)
(if (setq at (car (nentselp g2)))
(if (eq "ATTRIB" (cdr (assoc 0 (entget at))))
(progn
(vla-put-textstring (vlax-ename->vla-object at) st)
(vl-cmdf "_.updatefield" at "")
(princ ms)
)
(princ (strcat "\nObject is not an Attribute." ms))
)
(princ (strcat "\nMissed, try again." ms))
)
t
)
)
)
)
(redraw en 4)
(redraw)
(vla-endundomark ad)
)
)
(princ)
)
(vl-load-com) (princ)
页:
[1]
2