社区 › Auto Lisp › 多段线的面积

GP_ 发表于 2022-7-6 09:27:17

要在放置文本时查看文本。。。
（更好的CMDECHO=0）
 

(defun c:TesT (/ ss p)
;; Tharwat 18. Nov. 2011 ;;
   (if (and (setq ss (car (entsel "\n Select a closed polyline :")))
            (vlax-curve-IsClosed ss)
       )
       (progn
         (entmake '((0 . "BLOCK")(2 . "_area_")(70 . 0)(10 0.0 0.0 0.0)))
         (entmake
               (list
                   '(0 . "TEXT")
                   '(10 0.0 0.0 0.0)
                   (cons 40 (getvar 'textsize))
                   (assoc 8 (entget ss))
                   (cons 1
                     (strcat
                           (rtos (cvunit (vla-get-area (vlax-ename->vla-object ss)) "inch" "ft")
                                        2 2
                           )
                           "sf"
                     )
                   )
               )
         )
         (entmake '((0 . "ENDBLK")))
         (prompt "\n ")
         (prompt "\n Specify Text location : ")
         (command "_-insert" "_area_" pause "1" "1" "0")
         (command "_explode" "_L")   
       )
   )
   (princ)
)

nnutting 发表于 2022-7-6 09:31:57

仍然不工作。。。我的10'x10'盒子的面积将达到1200.00sf。。。

Lee Mac 发表于 2022-7-6 09:38:50

写得很快，
 
(defun c:test ( / area en nm pt )
   (while
       (progn (setvar 'ERRNO 0) (setq en (car (entsel)))
         (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (vl-catch-all-error-p
                           (setq area (vl-catch-all-apply 'vlax-curve-getarea (list en)))
                     )
                     (princ "\nInvalid Object.")
                   )
               )
               (   (setq area nil)   )
         )
       )
   )
   (if (and area (setq pt (getpoint "\nPoint for Text: ")))
       (entmake
         (list
            '(0 . "TEXT")
               (cons 210 (setq nm (trans '(0.0 0.0 1.0) 1 0 t)))
               (cons10 (trans pt 1 nm))
               (cons40 (getvar 'TEXTSIZE))
               (assoc8 (entget en))
               (cons50 (angle '(0.0 0.0 0.0) (trans (getvar 'UCSXDIR) 0 nm t)))
               (cons   1 (rtos (/ area 144.0) 2))
         )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Tharwat 发表于 2022-7-6 09:43:57

 
你说得对，我不应该像在套路中那样使用转换，我应该像李那样使用它（/区域144）。
 
如果你有兴趣使用我的程序，就替换这个。
 

(rtos (cvunit (vla-get-area (vlax-ename->vla-object ss)) "inch" "ft") 2 2 )
 
用这个。。
 
(rtos (/ (vla-get-area (vlax-ename->vla-object ss)) 144.) 2 2 )

查看完整版本: 多段线的面积