社区 › AutoLISP/Visual LISP 编程技术 › 请教：如何提取多段线的周长和面积

yaker77 发表于 2012-9-24 15:08:24

请教：如何提取多段线的周长和面积

;;功能：逐个输出周长和面积
(defun C:amm00(/ SSS LLL)

;;;   (setq height(getdist "\n请输入文字高度:") )


   (repeat 50                              ;循环50次
      (if
          (null


    (if(setq e (entsel "请选择一个对象："))
      (progn
            (vl-load-com)
            (setq modelspace (vla-get-Modelspace (vla-get-activeDocument(vlax-get-acad-object))))
            (setq obj(vlax-entsel->vla-object entsel))
            (if(vlax-property-available-p obj "area")
                (setq SSS (vlax-get-property obj 'area) )
            )
            (if(=(cdr(assoc 0(entget entsel))) "MLINE")
                (setq LLL (ml-length entsel))
                  
            )

            (setq text1(strcat "S: "(rtos (/ SSS 1000000) 2 2) "m2" "L: "(rtos (/ LLL 1000) 2 2) "m")
            )
            (if(setq insertpt(getpoint "\n请输入文字插入点: "))
                (setq insertp1(vlax-3d-point insertpt)
                  textobj1 (vla-addtext modelspace text1 insertp1 500)
                )
            )
       )
   )

      
          )
          (exit)
      )
   )

)


我想逐个输出周长和面积，但以上红色的部分没办法提取多段线的周长和面积，向高手求助。谢谢！

yaker77 发表于 2012-9-24 15:09:35

补充一下，如何输入文字高度，而不是通过指定距离。

alin 发表于 2012-9-25 22:39:16

程序有些问题，建议楼主上图并解释清楚意图，相信很多同学都能帮你

yaker77 发表于 2012-9-26 12:15:10

已经改好了，还是谢谢学友们的支持！

;;;功能：逐个输出周长和面积
(defun C:amm0(/ ss l i totalarea ename obj entareashujuS shujuL)


;;;   (setq height(getdist "\n请输入文字高度:") )

      (setq height(getreal "\n请输入文字高度:") )


   (repeat 50                              ;循环50次
      (if
          (null


    (if(setq ent (entsel "请选择一个对象："))
      (progn
            (vl-load-com)
            (setq modelspace (vla-get-Modelspace (vla-get-activeDocument(vlax-get-acad-object))))

            (setq SSS 0 LLL 0)
            (setq obj(vlax-ename->vla-object (car ent)))


            (setq text1(strcat "S: "(rtos (/ (vlax-get-property obj 'area) 1000000) 2 2) "m2" "L: "(rtos (/ (vla-get-Length obj ) 1000) 2 2) "m")

            )
            (if(setq insertpt(getpoint "\n请输入文字插入点: "))

                (setq insertp1(vlax-3d-point insertpt)

                  textobj1 (vla-addtext modelspace text1 insertp1 500)

                )

            )
       )
   )


      
          )
          (exit)
      )

   )

)

davide888 发表于 2014-3-8 15:14:45

做个记号   

小师傅 发表于 2014-3-17 13:35:14

正好用得上，谢谢

llsheng_73 发表于 2014-3-17 14:50:16

印象中有的多线段(vla-get-Length obj )会得不到任何长度

luojunmax 发表于 2015-8-27 21:39:31

谢谢了，可以用，辛苦了

查看完整版本: 请教：如何提取多段线的周长和面积