oldenn 发表于 2013-8-2 15:40:07

求完善并扩展 填充面积统计

本帖最后由 oldenn 于 2013-8-6 14:01 编辑

在论坛下载了一个lsp，可以实现命令行返回所选的不同填充面积分别汇总，详附件tcx.lsp，仅供参考【抱歉一下找不到原帖地址了，在此感谢。】
要求完善并扩展达到以下功能：

在图上标注填充图案的面积，以填充图案名称命名，有多处相同填充图案的应编号。


简化了一下，请高手帮忙

mmmmmm 发表于 2013-8-2 15:40:08

(Defun c:AutoHatchArea (/   DATAI          LL        MID   MTO   MTXTNUM
                        OBJ   OID   PNAME SS        TXT   TXT0TXT1UR
                        VAL
                     )
(setq        txt0 "%<\\AcObjProp Object(%<\\_ObjId 00000000>%).PatternName \\f \042%tc1\042>%-"
        txt1 "\\PA=%<\\AcObjProp Object(%<\\_ObjId 00000000>%).Area \\f \042%lu2%pr2%ps[,m2]%ct8\042>%"
        mtxt (list (cons 0 "MTEXT")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbMText")
                   (cons 1 " ")
                   (list 10 0.0 0.0 0.0)
                   (cons 40 50.0) ; MTEXT HEIGHT
                   (cons 50 0.0)
                   (cons 62 1)
                   (cons 71 5)
                   (cons 72 5)
                   (cons 90 1)
                   (cons 45 1.2)
             )
)
(if (setq i-1
          ss (ssget '((0 . "hatch")))
      )
    (repeat (sslength ss)
      (setq obj          (vlax-ename->vla-object (ssname ss (setq i (1+ i))))
          oid          (vl-prin1-to-string (vlax-get-property obj "ObjectID"))
          pname (vlax-get-property obj "PatternName")
      )
      (if (null (setq num (cdr (assoc pname data))))
        (setq num1
              data (list (cons pname num))
        )
        (setq num (1+ num))
      )
      (setq data (subst (cons pname num) (assoc pname data) data))
      (vla-getboundingbox obj 'll 'ur)
      (setq ll        (vlax-safearray->list ll)
          ur        (vlax-safearray->list ur)
          mid        (polar ll (angle ll ur) (* 0.5 (distance ll ur)))
          mid        (trans mid 0 1)
          val        (strcat        (vl-string-subst oid "00000000" txt0)
                        (itoa num)
                        (vl-string-subst oid "00000000" txt1)
                )
          txt        (subst (cons 10 mid) (assoc 10 mtxt) mtxt)
          mto        (entmake txt)
          mto        (vlax-ename->vla-object (entlast))
      )
      (vla-put-textstring mto val)
    )
)
(princ)
)

429014673 发表于 2013-8-2 17:36:52

要求很高，就看高手了

oldenn 发表于 2013-8-3 11:24:58

顶下，求高人出手

lizhiqiang9801 发表于 2013-8-5 10:51:33

顶贴 期待高手出手

oldenn 发表于 2013-8-6 01:21:43

顶上。。。。。。。。

oldenn 发表于 2013-8-6 13:58:20

简化了一下，请高手帮忙

cxs259 发表于 2013-8-9 15:30:29

7楼基本满足楼主的要求，请楼主把30个明经币给他吧

bai2000 发表于 2013-8-9 15:36:48

7楼的，能改下，字体大小可以量取定义最好

mmmmmm 发表于 2013-8-9 18:37:31

不要给我，捐到论坛吧。
页: [1] 2 3
查看完整版本: 求完善并扩展 填充面积统计