放置数字、周长和

Hattie · 发表于 2022-7-6 17:11:53

我有一个lisp例程，将多行文字放置在多边形上，以获得房间名称及其面积，如下所示。在这个例程中，我也想添加要显示的周长。我已经尝试了很多方法来完成日常工作，不幸的是，它不起作用。你能帮我显示多边形或多段线的周长以及它们的数字和面积吗。非常感谢你的帮助。

copy


;        
(defun drtxt (/ rn tx ls vl lt ht lb hb nr pt)
 (setq tx (strcat "Area: " 
      (rtos (/ (getvar "area") 1000000) 2 2) 
      " m2"
      )         
      rn (getstring "\nRoom Name: ")
 )
 (setq ls (list (cons 1 tx))
     vl (textbox ls)
     vl (cadr vl)
     lt (car vl)
     ht (cadr vl)
     vl (grread T)
     nr (car vl)
     pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx "")
 (redraw)
) ; end drtxt function
(defun c:pla ()
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (command "area" "o" et)
 (drtxt)
 ) ; wnd while funtion
(setvar "cmdecho" 1)
(princ)
) ; end c:pla function

lpseifert · 发表于 2022-7-6 17:29:16

我没有测试，但你可以试试这个

copy


;        
(defun drtxt (/ rn tx ls vl lt ht lb hb nr pt)
 (setq tx (strcat "Area: " 
      (rtos (/ (getvar "area") 1000000) 2 2) 
      " m2"
      )         
      rn (getstring "\nRoom Name: ")
   [color=Red]per (strcat "Perimeter: " (rtos (/ (getvar "perimeter") 1000) 2 2) " m")[/color]
 )
 (setq ls (list (cons 1 tx))
     vl (textbox ls)
     vl (cadr vl)
     lt (car vl)
     ht (cadr vl)
     vl (grread T)
     nr (car vl)
     pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx[color=Red] per[/color] "")
 (redraw)
) ; end drtxt function
(defun c:pla ()
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (command "area" "o" et)
 (drtxt)
 ) ; wnd while funtion
(setvar "cmdecho" 1)
(princ)
) ; end c:pla function

rkmcswain · 发表于 2022-7-6 17:33:06

这里有一种方法。

copy


(defun drtxt (ar px rn / ls vl lt ht lb hb nr pt pr tx)
;;;  (setq tx (strcat "Area: " 
;;;       (rtos (/ (getvar "area") 1000000) 2 2) 
;;;       " m2"
;;;       )         
;;;       rn (getstring "\nRoom Name: ")
;;;               
;;;
;;;  )
 (setq tx (strcat (rtos (/ ar 1000000.0) 2 2) " m2")
pr (strcat "P= " (rtos px 2 2))
ls (list (cons 1 tx))
       vl (textbox ls)
       vl (cadr vl)
       lt (car vl)
       ht (cadr vl)
       vl (grread T)
       nr (car vl)
       pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx pr "")
 (redraw)
) ; end drtxt function
(defun c:pla ( / et obj ar px rn)
 (vl-load-com)
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (setq obj (vlax-ename->vla-object et))
 (setq ar (vla-get-Area obj))
 (setq px (vla-get-Length obj))
 (setq rn (getstring "\nRoom Name: "))
 
 ;(command "area" "o" et)
 (drtxt ar px rn)
 ) ; wnd while funtion
(setvar "cmdecho" 1)
(princ)
)