这个命令标注出来面积时 会多生成一天多段线。

胡杰45558

(defun c:mj();生成面域并在其内标注面积(亩)和质心
;(VL-LOAD-COM)
;(setq AcadObject (vlax-get-acad-object)
;AcadDocument (vla-get-ActiveDocument AcadObject)
;mSpace (vla-get-ModelSpace AcadDocument)
;)
;(setq ss (ssget))
;(while(>(sslength ss)0)
(setq p1 t)
(while p1
(if *error*
;(command "_boundary" (setq p1 (getpoint "点取封闭区域内部的一点:")) "A" "o" "R" "" "")
;(command "_boundary" (setq p1 (getpoint "点取封闭区域内部的一点:")) "Y" "A" "o" "R" "" "")
(command "_boundary" (setq p1 (getpoint "\n点取封闭区域内部的一点:"))  "")
)
(setq EN (entlast))
(command "area" "o" EN)
(setq AA (getvar "area"))
(setq aa (/ aa 2000))
(setq aa (* aa 3))
(setq sss (RTOS aa 2 2))
(setq sss (strcat  sss  "亩"))
;(setq Centriod (vla-get-Centroid (vlax-ename->vla-object EN)))
;(setq x (vlax-safearray-get-element (vlax-variant-value Centriod) 0))
;(setq y (vlax-safearray-get-element (vlax-variant-value Centriod) 1))
(if (=  ffsize nil)
    (progn
      (setq ffsize 2)
      )
    )
;(setq ss (strcat "\n输入字体的高度<" (rtos ffsize 2 1) ">:"))
;(setq ffsize1 (getreal ss))
; (if  ffsize1
   ; (setq ffsize ffsize1)
    ;)
(COMMAND "TEXT" p1 ffsize 0 sss)
;(COMMAND "TEXT" (list x y 0) 0.5 0 sss)
;(entdel en) ;把;号去掉就可以把生成的区域线删掉
;(command "circle" (list x y 0) 500 "")
)
nil
)
(defun c:wb2();生成面域并在其内标注面积(m2)和质心
;(VL-LOAD-COM)
;(setq AcadObject (vlax-get-acad-object)
;AcadDocument (vla-get-ActiveDocument AcadObject)
;mSpace (vla-get-ModelSpace AcadDocument)
;)
(setq p1 t)
(while p1
(if *error*
;(command "_boundary" (setq p1 (getpoint "点取封闭区域内部的一点:")) "A" "o" "R" "" "")
;(command "_boundary" (setq p1 (getpoint "点取封闭区域内部的一点:")) "Y" "A" "o" "R" "" "")
(command "_boundary" (setq p1 (getpoint "\n点取封闭区域内部的一点:"))  "")
)
(setq EN (entlast))
(command "area" "o" EN)
(setq AA (getvar "area"))
(setq sss (RTOS aa 2 4))
(setq sss (strcat "S=" sss  "平方米"))
;(setq Centriod (vla-get-Centroid (vlax-ename->vla-object EN)))
;(setq x (vlax-safearray-get-element (vlax-variant-value Centriod) 0))
;(setq y (vlax-safearray-get-element (vlax-variant-value Centriod) 1))
  (if (=  ffsize nil)
    (progn
      (setq ffsize 0.5)
      )
    )
(setq ffsize1 (getreal (strcat "\n输入字体的高度<" (rtos ffsize 2 1) ">:")))
  (if  ffsize1
    (setq ffsize ffsize1)
    )
(COMMAND "TEXT" p1 ffsize 0 sss)
;(COMMAND "TEXT" (list x y 0) 0.5 0 sss)
;(entdel en) ;把;号去掉就可以把生成的区域线删掉
;(command "circle" (list x y 0) 500 "")
)
nil
)
(princ "\n更多资源添加QQ964265407")
(princ)


该贴已经同步到 胡杰45558的微博

胡杰45558

是多生成一条多段线，怎么解决，怎么修改！

dingtiedt

第一，(setq EN (entlast))修改为(setq ( EN (ssadd (entlast)))
第二，在(setq AA (getvar "area"))下面增加一句(command "erase" en "")

胡杰45558

dingtiedt 发表于 2015-9-8 19:51
第一，(setq EN (entlast))修改为(setq ( EN (ssadd (entlast)))
第二，在(setq AA (getvar "area"))下面增 ...

谢谢！我知道呢