1291500406 发表于 2019-8-22 22:40:02

Visual LISP练习--文字标注面积

本帖最后由 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))


bai2000 发表于 2019-8-23 09:12:19

字高能鼠标量取最好

永不言弃 发表于 2019-8-23 09:20:14

本帖最后由 永不言弃 于 2019-8-23 09:21 编辑

bai2000 发表于 2019-8-23 09:12
字高能鼠标量取最好

(defun c:bb (/ th ss obj pt pt2 textobj)
(vl-load-com)
(setq th (getdist "\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)
)

1291500406 发表于 2019-8-23 22:26:37

bai2000 发表于 2019-8-23 09:12
字高能鼠标量取最好

2006年入门的你，getreal和getdist都没搞懂？

xvjiex 发表于 2019-8-24 15:07:43

都是高手！

594826903 发表于 2019-12-17 09:29:20

支持一下虽然2020用不了！
页: [1]
查看完整版本: Visual LISP练习--文字标注面积