newer 发表于 2025-1-10 09:38:25

动态显示矩形的面积等信息





(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)
)


页: [1]
查看完整版本: 动态显示矩形的面积等信息