明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1209|回复: 5

[源码] Visual LISP练习--文字标注面积

[复制链接]
发表于 2019-8-22 22:40 | 显示全部楼层 |阅读模式
本帖最后由 1291500406 于 2019-8-22 23:04 编辑

(defun c:bb (/ th ss obj pt pt2 textobj)
(vl-load-com)(setq th (getreal "\n必强提示:字高<100>:"))(if (not th)(setq th 100))(setq ss (ssget '((0 . "HATCH")))i -1)
(if ss(progn(repeat (sslength ss)(setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
(vla-GetBoundingBox obj 'minpt 'maxpt)(setq pt(mapcar '(lambda (x) (/ x 2.0))(mapcar '+
(vlax-safearray->list minpt)(vlax-safearray->list maxpt)))pt2 (vlax-make-safearray vlax-vbDouble '(0 . 2))
textobj(vla-addtext  (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object)))
(strcat "S" (itoa i) "=" (rtos (/ (vla-get-area obj) 1000000) 2 3) "㎡")(vlax-3d-point pt) th)) (vlax-safearray-fill pt2 pt)
(vla-put-Alignment textobj 10)(vla-put-TextAlignmentPoint textobj pt2))))(princ))


本帖子中包含更多资源

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

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2019-8-23 09:12 | 显示全部楼层
字高能鼠标量取最好
发表于 2019-8-23 09:20 | 显示全部楼层
本帖最后由 永不言弃 于 2019-8-23 09:21 编辑
bai2000 发表于 2019-8-23 09:12
字高能鼠标量取最好

  1. [code=lisp](defun c:bb (/ th ss obj pt pt2 textobj)
  2.   (vl-load-com)
  3.   (setq th (getdist "\n字高<100>:"))
  4.   (if (not th)
  5.     (setq th 100)
  6.   )
  7.   (setq        ss (ssget '((0 . "HATCH")))
  8.         i  -1
  9.   )
  10.   (if ss
  11.     (progn
  12.       (repeat (sslength ss)
  13.         (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
  14.         (vla-GetBoundingBox obj 'minpt 'maxpt)
  15.         (setq pt      (mapcar '(lambda (x) (/ x 2.0))
  16.                               (mapcar '+
  17.                                       (vlax-safearray->list minpt)
  18.                                       (vlax-safearray->list maxpt)
  19.                               )
  20.                       )
  21.               pt2     (vlax-make-safearray vlax-vbDouble '(0 . 2))
  22.               textobj (vla-addtext
  23.                         (vla-get-Modelspace
  24.                           (vla-get-activeDocument (vlax-get-acad-object))
  25.                         )
  26.                         (strcat        "S"
  27.                                 (itoa i)
  28.                                 "="
  29.                                 (rtos (/ (vla-get-area obj) 1000000) 2 3)
  30.                                 "㎡"
  31.                         )
  32.                         (vlax-3d-point pt)
  33.                         th
  34.                       )
  35.         )
  36.         (vlax-safearray-fill pt2 pt)
  37.         (vla-put-Alignment textobj 10)
  38.         (vla-put-TextAlignmentPoint textobj pt2)
  39.       )
  40.     )
  41.   )
  42.   (princ)
  43. )
[/code]
 楼主| 发表于 2019-8-23 22:26 | 显示全部楼层
bai2000 发表于 2019-8-23 09:12
字高能鼠标量取最好

2006年入门的你,getreal和getdist都没搞懂?
发表于 2019-12-17 09:29 | 显示全部楼层
支持一下虽然2020用不了!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 06:05 , Processed in 0.234744 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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