发个小程序:框选图框内文字标注自动调整大小

1993063 · 发表于 2013-12-6 00:58:40

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 1993063 于 2013-12-6 07:48 编辑

(Defun c:tt ( / e i ii ptlist s1 sc ss sss x )
(setq i -1 ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))) ;属性块
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ptlist (getboundingbox s1))
(setq sss (ssget "W" (car ptlist)(cadr ptlist) '((0 . "DIMENSION,LEADER,*TEXT"))))
(repeat (setq ii (sslength sss))
(setq sc (GET-dxf 41 s1))
(setq e (ssname sss (setq ii (1- ii))) x (cdr (Assoc 0 (Entget e))))
(cond
((= x "TEXT") (CH-DXF e 40 (* sc (Getvar "dimtxt"))))
((= x "MTEXT") (CH-DXF e 40 (* sc (Getvar "dimtxt"))))
((= x "DIMENSION")(vla-put-ScaleFactor (vlax-ename->vla-object e) sc))
((= x "LEADER")(vla-put-ScaleFactor (vlax-ename->vla-object e) sc))
)
)
)
)
(Defun getboundingbox ( entName / entpl entpr )
(vla-getboundingbox (vlax-ename->vla-object entName) 'entpl 'entpr)
(Mapcar 'vlax-safearray->list (list entpl entpr))
)
(Defun GET-DXF ( i ent )(cdr (Assoc i (Entget ent))))

(Defun c:tt ( / e i ii ptlist s1 sc ss sss x ) 
  (setq i  -1 ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))) ;属性块 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (setq ptlist (getboundingbox s1)) 
    (setq sss (ssget "W" (car ptlist)(cadr ptlist) '((0 . "DIMENSION,LEADER,*TEXT")))) 
    (repeat (setq ii (sslength sss)) 
      (setq sc (GET-dxf 41 s1)) 
      (setq e (ssname sss (setq ii (1- ii))) x (cdr (Assoc 0 (Entget e)))) 
      (cond 
        ((= x "TEXT") (CH-DXF e 40 (* sc (Getvar "dimtxt")))) 
        ((= x "MTEXT") (CH-DXF e 40 (* sc (Getvar "dimtxt")))) 
        ((= x "DIMENSION")(vla-put-ScaleFactor (vlax-ename->vla-object e) sc)) 
        ((= x "LEADER")(vla-put-ScaleFactor (vlax-ename->vla-object e) sc)) 
      ) 
    ) 
  ) 
) 
(Defun getboundingbox ( entName / entpl entpr ) 
  (vla-getboundingbox (vlax-ename->vla-object entName) 'entpl 'entpr) 
  (Mapcar 'vlax-safearray->list (list entpl entpr)) 
) 
(Defun GET-DXF ( i ent )(cdr (Assoc i (Entget ent))))

1993063 · 发表于 2013-12-6 01:00:24

上面代码示意图片

st788796 · 发表于 2013-12-6 06:17:36

1993063 发表于 2013-12-6 01:00
上面代码示意图片

两个问题
1 程序中 dxf 用法和后面的子函数不一致
2 cond 可以用 if 分成两类，一类改 dxf 40，其余的 put-scalefactor

1993063 · 发表于 2013-12-6 07:41:39

本帖最后由 1993063 于 2013-12-6 07:49 编辑

st788796 发表于 2013-12-6 06:17
两个问题
1 程序中 dxf 用法和后面的子函数不一致
2 cond 可以用 if 分成两类，一类改 dxf 40，其余 ...

多谢提醒{:soso_e100:}少个函数
(Defun CH-DXF ( ename code val / old_num new_num ent )
  (if (setq ent (entget ename)
      new_num (cons code val)
      old_num (assoc code ent)
   )
(Entmod (subst new_num old_num ent))
(Entmod (reverse (cons new_num (reverse ent))))
  )
)

l18c19 · 发表于 2013-12-6 11:33:11

好程序，下载学习！

st788796 · 发表于 2013-12-6 11:39:58

1993063 发表于 2013-12-6 07:41
多谢提醒少个函数
(Defun CH-DXF ( ename code val / old_num new_num ent )
(if (setq ...

一般 cond 不要省略 (t) 项，安全

金鹅起飞 · 发表于 2013-12-6 11:59:18

1993063 发表于 2013-12-6 07:41
多谢提醒少个函数
(Defun CH-DXF ( ename code val / old_num new_num ent )
(if (setq ...

请问楼主：这个函数怎么加呀，您可以重新发一个可以用的程序吗？谢谢。

1993063 · 发表于 2013-12-6 12:40:36

金鹅起飞发表于 2013-12-6 11:59
请问楼主：这个函数怎么加呀，您可以重新发一个可以用的程序吗？谢谢。

一起加载就可以了

金鹅起飞 · 发表于 2013-12-6 12:42:47

1993063 发表于 2013-12-6 12:40
一起加载就可以了

是复制在原先的程序最后吗？我不懂，不好意思。

czb203 · 发表于 2013-12-6 14:48:15

相当不错的东西

混沌初开 · 发表于 2013-12-7 19:35:13

请问楼主动画怎么做的?

Lispboy · 发表于 2013-12-7 20:18:07

混沌初开发表于 2013-12-7 19:35
请问楼主动画怎么做的?

http://bbs.xdcad.net/thread-667674-1-1.html

甲方自定 · 发表于 2014-1-3 10:00:23

不错，收下了，谢谢。

NINJA213 · 发表于 2014-1-3 10:48:16

谢谢楼主！试一下

lizheng0406 · 发表于 2014-1-19 09:13:40

不错，好东西

账号		自动登录	找回密码
密码			立即注册

[每日一码] 发个小程序:框选图框内文字标注自动调整大小

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

评分

点评

点评

点评

点评

点评