明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 7374|回复: 23

[已解答] 求完善并扩展 填充面积统计

[复制链接]
发表于 2013-8-2 15:40 | 显示全部楼层 |阅读模式
30明经币
本帖最后由 oldenn 于 2013-8-6 14:01 编辑

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

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


简化了一下,请高手帮忙

附件: 您需要 登录 才可以下载或查看,没有账号?注册

最佳答案

查看完整内容

(Defun c:AutoHatchArea (/ DATA I LL MID MTO MTXT NUM OBJ OID PNAME SS TXT TXT0 TXT1 UR VAL ) (setq txt0 "%%-" txt1 "\\PA=%%" 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) ...
发表于 2013-8-2 15:40 | 显示全部楼层
(Defun c:AutoHatchArea (/     DATA  I          LL        MID   MTO   MTXT  NUM
                        OBJ   OID   PNAME SS        TXT   TXT0  TXT1  UR
                        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[1e-006]\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 num  1
              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)
)

评分

参与人数 1明经币 +1 收起 理由
oldenn + 1 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2013-8-2 17:36 来自手机 | 显示全部楼层
要求很高,就看高手了
回复

使用道具 举报

 楼主| 发表于 2013-8-3 11:24 | 显示全部楼层
顶下,求高人出手
回复

使用道具 举报

发表于 2013-8-5 10:51 | 显示全部楼层
顶贴 期待高手出手
回复

使用道具 举报

 楼主| 发表于 2013-8-6 01:21 | 显示全部楼层
顶上。。。。。。。。
回复

使用道具 举报

 楼主| 发表于 2013-8-6 13:58 | 显示全部楼层
简化了一下,请高手帮忙
回复

使用道具 举报

发表于 2013-8-9 15:30 | 显示全部楼层
7楼基本满足楼主的要求,请楼主把30个明经币给他吧
回复

使用道具 举报

发表于 2013-8-9 15:36 | 显示全部楼层
7楼的,能改下,字体大小可以量取定义最好
回复

使用道具 举报

发表于 2013-8-9 18:37 | 显示全部楼层
不要给我,捐到论坛吧。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 21:30 , Processed in 0.532436 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表