'警报#039；带foc的盒子
大家好，有没有一种方法可以创建某种漂浮在DWG上的“alertbox”，而不需要从DWG中获取焦点？
我找到了函数（acet ui status“Message”“Title”），但它只允许3行文本。我想用多一点。。。。
对此有什么建议吗？ 只是另一个论坛的一些引述：
</blockquote> 感谢Grrr的回复，
我还找到了acet ui txted函数，但也保留了“焦点”。
我从你的另一篇文章中了解到，我试图描述的是不可能的？
啊该死-你说得对，对不起。我对acet-*函数也不够熟悉。
是的，但是：
这意味着额外安装一个软件。。。
除非有人提出不同的建议。 我不明白的是为什么（acet ui status）的功能只支持3行文本-(
看起来acet ui txted也被限制为最多15行：
(acet-ui-txted
( (lambda ( / s i ) (repeat 100 (setq s (strcat (cond (s (strcat s "\r\n"))("")) (itoa (setq i (1+ (cond (i)(0))))))))) )
"Caption" "Note"
) 也许/不知道你想要完成什么，但你可以使用grdraw。这是李大师的一个很酷的例子：-）
http://www.lee-mac.com/grtext.html
否则，你必须结合lisp例程和reactor创建某种智能字段或块，以便在每次缩放或平移后进行缩放，并可能将“注释”放在锁定层上。。大声想想。
gr.Rlx
有趣的想法：
(defun C:test nil
(
(lambda (txt / cad spc o ll ur)
(and
(setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (setq cad (vlax-get-acad-object))))))
(setq o (vla-AddMText spc (vlax-3d-point '(0. 0. 0.)) 1 txt))
(progn
(vla-GetBoundingBox o 'll 'ur)
(vla-ZoomWindow cad ll ur)
(vla-ZoomScaled cad 0.5 acZoomScaledRelative)
(while (not (grread)))
(repeat 2 (vla-ZoomPrevious cad))
(vl-catch-all-apply 'vla-Delete (list o))
)
)
)
"Hello\nWorld!"
)
)
这肯定会引起人们的注意 我之所以尝试这样做，是为了制作一个“弹出窗口”，即时反馈线路长度和面积等信息。
我现在必须遵循代码，它正是我想要的。
但是
使用的（acet ui状态）函数只能处理3行文本。。。。我想用更多！
(defun c:MINIQUANTUMPANELAAN (/ itemarea itemperimeter itemlinelength
itemarclength itemsplinelength itemregionperimeter itemcircumference
itemsplineperimeter itemplineperimeter itemplinelength itemtracelength
itemarclength itemellipselength a b c d p1 p2 itemlength tarea tperim tlength
)
(vl-load-com)
(defun *oo_object_modification* (objreactor objectsmodified)
(setq selected_objects (vla-get-pickfirstselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq itemarea 0
itemperimeter 0
itemlinelength 0
itemarclength 0
itemsplinelength 0
itemregionperimeter 0
itemcircumference 0
itemsplineperimeter 0
itemplineperimeter 0
itemplinelength 0
itemtracelength 0
itemarclength 0
itemellipselength 0
)
;AREA
(vlax-for n selected_objects
(if (vlax-property-available-p n 'area)
(if (eq (vla-get-objectname n) "AcDbRegion")
(setq itemarea (+ itemarea (vla-get-area n)))
(if (vlax-curve-isclosed n)
(setq itemarea (+ itemarea (vla-get-area n)))
)
)
)
;;CIRCLE
(if (vlax-property-available-p n 'circumference)
(setq itemcircumference (+ itemcircumference (vla-get-circumference n)))
)
;;SPLINE
(if (eq (vla-get-objectname n) "AcDbSpline")
(if (vlax-curve-isclosed n)
(setq itemsplineperimeter (+ itemsplineperimeter
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
(setq itemsplinelength (+ itemsplinelength
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
)
)
;;REGION
(if (eq (vla-get-objectname n) "AcDbRegion")
(setq itemregionperimeter (+ itemregionperimeter (vla-get-perimeter n)))
)
;;PLINE
(if (or (eq (vla-get-objectname n) "AcDb2dPolyline")
(eq (vla-get-objectname n) "AcDbPolyline")
)
(if (vlax-curve-isclosed n)
(setq itemplineperimeter (+ itemplineperimeter
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
(setq itemplinelength (+ itemplinelength
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
)
)
;;LINE
(if (eq (vla-get-objectname n) "AcDbLine")
(setq itemlinelength (+ itemlinelength (vla-get-length n)))
)
;;ARC
(if (eq (vla-get-objectname n) "AcDbArc")
(setq itemarclength (+ itemarclength (vla-get-arclength n)))
)
(if (eq (vla-get-objectname n) "AcDbEllipse")
(setq itemellipselength (+ itemellipselength
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
)
;;TRACE
(if (eq (vla-get-objectname n) "AcDbTrace")
(progn (setq plist (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates n))
)
)
(setq a (list (nth 0 plist) (nth 1 plist) (nth 2 plist)))
(setq b (list (nth 3 plist) (nth 4 plist) (nth 5 plist)))
(setq c (list (nth 6 plist) (nth 7 plist) (nth 8 plist)))
(setq d (list (nth 9 plist) (nth 10 plist) (nth 11 plist)))
(setq p1 (polar a (angle a b) (/ (distance a b) 2.0)))
(setq p2 (polar c (angle c d) (/ (distance c d) 2.0)))
(setq itemtracelength (+ itemtracelength (distance p1 p2)))
)
)
)
;;_end vlax-for
(setq itemperimeter (+ itemcircumference
itemsplineperimeter
itemregionperimeter
itemplineperimeter
)
)
(setq itemlength (+ itemplinelength itemsplinelength itemlinelength itemtracelength itemarclength itemellipselength)
)
(setq tarea (rtos itemarea 2 3))
(setq HBTotal (+ itemperimeter itemlength))
(setq HBT (rtos HBTotal 2 3))
(setq tperim (rtos itemperimeter 2 )
(setq tlength (rtos itemlength 2 )
(acet-ui-status (strcat "Totaal oppervlak: " tarea " m2" "\n"
"Totaal lengte: " HBT " m1") "Mini QuantumPanel"
)
)
;;OBJECT SELECTION
(if oo_object_modification
(progn (vlr-remove oo_object_modification)
(setq oo_object_modification nil)
)
)
(setq oo_object_modification
(vlr-miscellaneous-reactor
nil
'((:vlr-pickfirstmodified . *oo_object_modification*))
)
)
;;Command ended
(if oo_object_modification_action
(progn (vlr-remove oo_object_modification_action)
(setq oo_object_modification_action nil)
)
)
(setq oo_object_modification_action
(vlr-command-reactor nil
'((:vlr-commandended . *oo_object_modification*)
;(:vlr-commandcancelled . *oo_object_modification_CANCEL*))
)
)
)
)
(defun c:MINIQUANTUMPANELUIT ()
(if oo_object_modification_action
(progn (vlr-remove oo_object_modification_action)
(setq oo_object_modification_action nil)
)
)
(if oo_object_modification
(progn (vlr-remove oo_object_modification)
(setq oo_object_modification nil)
)
)
)
页:
[1]
2