[已解決]關於lisp(長度標示)

請問各位先知
   標註長度的lisp，如何修改為可乘上高度後標註為面積(m2)

例:平面圖內牆長度為1.2m，高度(2.4)(可變動)，該線段面積為2.88(m2)


(defun c:EB1()

(setvar "cmdecho" 0)

(setq en (entsel "\n選取圓、線、弧、聚合線計算長度: "))

(while en

(setq en (car en))

(command "lengthen" en "")

(setq dd (getvar "perimeter"))

(princ (strcat "\n長度=" (rtos dd 2)"cm"))

(setq pt (getpoint "\n文字插入點: "))

(setq old_hh (getvar "textsize"))

(setq str_hh (strcat "\n文字高度 <" (rtos old_hh 2) ">: "))

(setq hh (getdist pt str_hh))

(if (null hh) (setq hh old_hh))

(command "text" pt hh 0 (strcat "" (rtos (/ dd 100) 2) "m"))
(setq en (entsel "\n選取圓、線、弧、聚合線計算長度: "))
)
(prin1)
)
.

各自替換以下3行看一下不同之處，差別只在於提示單位表示及紅色區計算區

以M為輸入單位
(princ (strcat "\n長度=" (rtos dd 2)"M"))
(setq str_hh (strcat "\n文字高度 <" (rtos old_hh 2) "M >: "))
(command "text" pt hh 0 (strcat "" (rtos (* dd HH) 2) "M2"))


以CM為輸入單位
(princ (strcat "\n長度=" (rtos dd 2)"CM"))
(setq str_hh (strcat "\n文字高度 <" (rtos old_hh 2) "CM >: "))
(command "text" pt hh 0 (strcat "" (rtos (/ (* dd HH) 10000) 2) "M2"))

感謝adslwang先知的回覆
(問題已經解決一半了)
但是如果高度是0.15m而文字高度也是0.15
高度是3m而文字高度也是3
所以整個圖面的文字就會忽大忽小的，是否能夠僅輸入高度作計算而文字高度能統一之寫法

(defun c:EB1()
(setvar "cmdecho" 0)
(setq old_hh (setvar "textsize" 3))
(setq str_hh (strcat "\n文字高度 <" (rtos old_hh 2 0) "M >: "))
(setq hh (getdist pt str_hh))
(if (null hh) (setq hh old_hh))
(while (setq en (entsel "\n選取圓、線、弧、聚合線計算長度: "))
(setq en (car en))
(command "lengthen" en "")
(setq dd (getvar "perimeter"))
(princ (strcat "\n長度=" (rtos dd 2)"M"))
(setq pt (getpoint "\n文字插入點: "))
(command "text" pt hh 0 (strcat "" (rtos (* dd HH) 2) "M2")))
(prin1))

依您的說明，調整一下位置，並假設基本字高為3，因為有的圖檔原設字高都不一樣.....
還有其它可以調整，讓其它前輩幫你吧！只到這裏了.......

感謝adslwang先知您的幫忙，我有在修改了一下3Q


有需要的人煩請自行服用吧


(defun c:ll()

(setvar "cmdecho" 0)

(setq en (entsel "\n選取圓、線、弧、聚合線計算長度: "))

(while en

(setq en (car en))

(command "lengthen" en "")

(setq dd (getvar "perimeter"))

(princ (strcat "\n長度=" (rtos dd 2)"M"))

(setq pt (getpoint "\n文字插入點: "))

(setq old_hh (getvar "textsize"))

(setq str_hh (strcat "\n文字高度 <" (rtos old_hh 2) "M >: "))

(setq hh (getdist pt str_hh))

(if (null hh) (setq hh old_hh))

(command "text" pt hh 0 (strcat "" (rtos (* (/ dd 100) HH) 2) "M2"))

(setq en (entsel "\n選取圓、線、弧、聚合線計算長度: "))
)
(prin1)
)
..

剛好手邊有一個程式，內容較複雜，但可自行刪減成自己需要的內容，
一次設定好圖層、字型、字高與小數點精確度，以後就方便多了。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;牆長度及面積計算
;; 2013/08/11

(defun C:Y479 (/ scm shig sos ssca i ss ssn sth &d ip1 p2
LL TLL AL1 AL2 ALL AAL AA1 AA2 AA3 AAA)
(setq scm (getvar "cmdecho"))
(setq shig (getvar "highlight"))
(setq sos (getvar "osmode"))
(setq ssca (getvar "dimscale"))
(setvar "cmdecho" 0)
(setvar "highlight" 1)
(setvar "osmode" 512) ;; NEA (最近點)

(:set_layer: "CHINA" 3) ;; 載入圖層 "CHINA",顏色 3
;;(:set_style_CH: "CHINA") ;; 載入 "CHINA" 字型
(:set_textsize: 40) ;; 依 1/100 比例尺預設字高 40
(:set_deci: 2) ;; 小數點精確度設定
(if (null y479) (setq y479 250)) (setq Wh y479) ;; 預設牆面高度為 250cm
(setq p (getreal (strcat "\n指定牆面高度 <" (rtos Wh 2 &d) ">: ")))
(if p (setq Wh p)) (setq y479 Wh)
(prompt "\n選取 線/聚合線/雲行線/弧/圓/橢圓/面域 的圖元計算總長度... ")
(setq i 0 TLL 0)
(setq ss (ssget
'((0 . "REGION,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
;;面域 ,圓 ,橢圓 ,線 ,聚合線 ,雲行線,弧
(repeat (sslength ss)
(setq ssn (ssname ss i))
(command "lengthen" ssn "")
(setq LL (getvar "perimeter")) ;; 儲存由 AREA 或 LIST 指令計算的最後一個周長值
(setq TLL (+ TLL LL))
(setq i (1+ i)))
(setq AL1 (strcat "牆總長=" (rtos TLL 2 &d) "公分,")
AL2 (strcat " 即：" (rtos (* TLL 0.033) 2 &d) "台尺")
WHH (strcat " <指定高度=" (rtos Wh 2 &d) "公分>")
ALL (strcat AL1 AL2 WHH))
(setq AAL (* TLL Wh)
AA1 (strcat "牆面積=" (rtos (/ AAL 10000.0 ) 2 &d) "平方公尺,")
AA2 (strcat " 即：" (rtos (* AAL 0.00003025 ) 2 &d) "坪,")
AA3 (strcat " 即：" (rtos (* AAL 0.00003025 36) 2 &d) "才")
AAA (strcat AA1 AA2 AA3))

(setq ip1 (getpoint "\n面積資料圖面插入點或 [只顯示面積資料(Enter)]: "))
(if ip1
(progn
(setq p2 (polar ip1 (* 1.5 pi) (* 1.5 sth)))
(command "-TEXT" "j" "BL" ip1 sth 0 ALL)
(command "-TEXT" "j" "BL" p2 sth 0 AAA)))
(prompt (strcat "\n計算 " ALL))
(prompt (strcat "\n計算 " AAA))
(command "._REDRAW")
(princ "\n****** End! 結束! ******")

(setvar "cmdecho" scm)
(setvar "highlight" shig)
(setvar "osmode" sos)
(princ)
)
(prompt "\n****** Load << 牆長度及面積計算 >> Successful ******")
(prin1)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 依比例尺預設字高 sth >>>>>>

(defun :set_textsize: (h / ssca stex p)
(setq ssca (getvar "dimscale"))
(if (null stex) (setq stex (* 0.1 h ssca))) (setq sth stex)
;;(setq p (getdist (strcat "\n指定字高 <" (rtos sth 2 2) ">: ")))
;;(if p (setq sth p)) (setq stex sth)
;;(setvar "textsize" sth)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 小數點精確度設定 &d >>>>>>

(defun :set_deci: (n / sdec p)
(if (null sdec) (setq sdec n)) (setq &d sdec)
;;(setq p (getint (strcat "\n顯示小數點後 <" (rtos &d 2 0) "> 位數: ")))
;;(if p (setq &d p)) (setq sdec &d)
;;(setvar "luprec" &d)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 載入圖層 >>>>>>

(defun :set_layer: (lay_name lay_color / chklay)
(setq chklay (tblsearch "layer" lay_name))
(if (null chklay) (command "-LAYER" "_M" lay_name "_C" lay_color "" "_L" "" "" ""))
(setvar "clayer" lay_name) ;; 設定目前圖層
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 載入字型 >>>>>>

(defun :set_style_CH: (sty_name / chksty)
(setq chksty (tblsearch "style" sty_name))
(if (null chksty) (command "-STYLE" sty_name "txt,chineset" "" "" "" "" "" "")) ;; 中文橫式書寫
(setvar "textstyle" "CHINA") ;; 設定目前的字型為 CHINA
)
(princ)

將文字高度與比例尺"綁"在一起，不管你是以1/10或1/200繪圖，出圖後的每一圖面文字高度都會一樣。

謝謝大家的分享