匹配注释比例
大家好，我发现了一个非常有用的lisp来获取面积，它工作得很好。我只想做一些小改动（如果可能的话），根据当前注释比例匹配文本高度？;
; Select closed polyline and place mtext with the room name and Area in m2
;
; How to use:
; 1. select polyline
; 2. type in room name
; Note: the getstring function does not allow spaces, so use a _ underscore to seperate words
; 3select insert point
; 4Something similar to this will be placed with MTEXT
; room_name
; Area: 111.11 m2
; 5MTEXT will be placed with no wrap, to current settings
;
; Created
; 11-June-2003 YZ
; This code was taken from an internet web site. the original author was 'Jos van Doorn'.
; Among other things, I have modified the program to use MTEXT.
;
(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
页:
[1]