Code Red > XDRX-API
[XDrX-PlugIn(163)] Dynamically display the area ect.. information of rectange
(1/1)
xdcad:
https://www.cadtutor.net/forum/topic/70763-display-the-area-by-picking-rectangle/
--- Code: ---(defun c:xdtb_dynrecarea (/ #mcolor cen data dynpt height lastpnt mArea nums
p-1 p2 p-2 pn1 pt1 pt2 pts str txt wid
)
(defun _callback (dynpt)
(if (not (and
(equal pn1 dynpt 1e-3)
(equal lastpnt dynpt 1e-3)
)
)
(progn
(setq lastpnt dynpt
pt2 (xdrx-getpropertyvalue (list pn1 p-2) "getclosestpointto"
dynpt t
)
)
(setq pt1 (xdrx-getpropertyvalue (list pn1 p-1) "getclosestpointto"
dynpt t
)
wid (distance pt2 dynpt)
height (distance pt1 dynpt)
pts (list pt2 dynpt pt1 pn1)
cen (xdrx-line-midp dynpt pn1)
mArea (* wid height)
nums (length data)
str (xdrx-string-formatex (xdrx-string-multilanguage "宽度= %.1f\r\n高度= %.1f\r\n面积=%.1f" "Width= %.1f\r\nHeight= %.1f\r\nArea=%.1f")
wid height mArea
)
)
(xd::grdraw:drawtext txt str cen 5 (* (getvar "viewsize") 0.025) 2
(getvar "ucsxdir") nil 8
)
)
)
str
)
(xdrx-begin)
(xdrx-sysvar-push '("osmode" 8))
(if (setq pn1 (getpoint (xdrx-string-multilanguage "\n矩形起始点<退出>:" "\nRect Start Point<Exit>:")))
(progn
(setq #mcolor 1)
(setq p-1 (mapcar
'+
pn1
'(1 0 0)
)
p-2 (mapcar
'-
pn1
'(0 1 0)
)
txt (xdrx-mtext-make)
)
(XD::Drag:CallBackSetMouseMove "_callback")
(if (setq p2 (xd::doc:getcorner pn1
(xdrx-string-multilanguage "\n对角点<退出>:" "\ndiagonal point<Exit>:")
#mcolor '(1 0 0)
)
)
(progn
(xdrx-polyline-make pts t)
(xdrx-setpropertyvalue (entlast) "color" #mcolor)
(xdrx-prompt (strcat "\n" str))
)
)
(xdrx-pointmonitor)
)
)
(xdrx-end)
(princ)
)
--- End code ---
Navigation
[0] Message Index
Go to full version