shaoxin3736 发表于 2012-12-31 12:11:10

求助：把下面面积标注精确到2位小数及0.00m2

(defun c:ttt(/ ACADDOC ACADSPC OBJAREA OBJLLPOINT OBJRUPOINT SELECTIONSET TEXTBASEPOINT TEXTHEIGHT TEXTINDEX TEXTOBJ)
   (vl-load-com)
   (setq AcadDoc (vla-get-activedocument (vlax-get-acad-object)))
   (if (= (getvar "TILEMODE") 1)(setq AcadSpc (vla-get-modelspace AcadDoc))(setq AcadSpc (vla-get-paperspace AcadDoc)))
   (setq TextHeight (getdist "\n输入标注文字高度:")
TextIndex (getint "\n输入起始编号:")
)
   (ssget '((0 . "LWPOLYLINE")))
   (setq Selectionset (vla-get-activeselectionset AcadDoc))
   (if (and TextHeight Selectionset TextIndex)
   (vlax-for Obj Selectionset
       (setq ObjArea (vla-get-area obj)
      ObjLlPoint nil
      ObjRuPoint nil
      )
       (vla-GetBoundingBox Obj 'ObjLlPoint 'ObjRuPoint)
       (setq TextBasePoint (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-safearray->list ObjLlPoint)(vlax-safearray->list ObjRuPoint))
      TextObj (vla-addtext AcadSpc (strcat (itoa TextIndex) "号面积=" (rtos (/ ObjArea 100000)) "m2") (vlax-3d-point TextBasePoint) TextHeight)
      )
       (vla-put-alignment TextObj acAlignmentCenter)
       (vla-put-TextAlignmentPoint TextObj (vlax-3d-point TextBasePoint))
       (setq TextIndex (1+ TextIndex))      
       )
   )
   )

hao3ren 发表于 2012-12-31 12:21:37

(strcat (itoa TextIndex) "号面积=" (rtos (/ ObjArea 100000) 2 2) "m2")

yjr111 发表于 2012-12-31 12:25:07

(rtos (/ ObjArea 100000))改为(rtos (/ ObjArea 100000)2 2)

shaoxin3736 发表于 2012-12-31 12:48:24

hao3ren 发表于 2012-12-31 12:21 static/image/common/back.gif
(strcat (itoa TextIndex) "号面积=" (rtos (/ ObjArea 100000) 2 2) "m2")

太感谢了

shaoxin3736 发表于 2012-12-31 12:48:56

yjr111 发表于 2012-12-31 12:25 static/image/common/back.gif
(rtos (/ ObjArea 100000))改为(rtos (/ ObjArea 100000)2 2)

多谢！！！！！！！

xiabin68 发表于 2012-12-31 13:34:44

支持一下，，，支持源码，

594826903 发表于 2019-12-16 13:28:15

支持一下很好的程序！
页: [1]
查看完整版本: 求助：把下面面积标注精确到2位小数及0.00m2