社区 › Auto Lisp › 放置数字、周长和

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

放置数字、周长和

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

;      

(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

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

;      

(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: ")
   per (strcat "Perimeter: " (rtos (/ (getvar "perimeter") 1000) 2 2) " m")
)
(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 per "")
(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

这里有一种方法。
 

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

)

Hattie 发表于 2022-7-6 17:46:57

非常感谢，它工作得很好！现在我知道我哪里做错了。我需要更加努力地学习。
 
 
 
 

Hattie 发表于 2022-7-6 17:58:29

非常感谢，它工作得很好！现在我知道我哪里做错了。我需要更加努力地学习。
 
 

Hattie 发表于 2022-7-6 18:05:52

我先试试你的习惯，一切都很好。非常感谢你
 
 

Hattie 发表于 2022-7-6 18:15:49

我一直在尝试回复你的消息，但我的消息会转到不同的回复。我一开始试过你的，效果很好。再次感谢

查看完整版本: 放置数字、周长和