承台土方体积快速计算(附源代码)

[code="lisp] (defun c:tt ()  (vl-load-com)  (setq os (getvar "osmode"))  (setvar "osmode" 0)  (setvar "cmdecho" 0)  (defun CLOCKWISEP (en / lw minp MaxP lst)    (setq lw (vlax-enam...

attachments-2019-06-jl1vs9c55d0c510113862.jpgattachments-2019-06-f3f4BM9x5d0c51077c654.jpgattachments-2019-06-iZtTICbV5d0c510ebd433.gif[code="lisp] 
(defun c:tt ()
  (vl-load-com)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (defun CLOCKWISEP (en / lw minp MaxP lst)
    (setq lw (vlax-ename->vla-object en))
    (vla-GetBoundingBox lw 'MinP 'MaxP)
    (setq
      minp (vlax-safearray->list minp)
      MaxP (vlax-safearray->list MaxP)
      lst  (mapcar
             (function
               (lambda (x)
                 (vlax-curve-getParamAtPoint
                   lw
                   (vlax-curve-getClosestPointTo lw x)
                 )
               )
             )
             (list minp
                   (list (car minp) (cadr MaxP))
                   MaxP
                   (list (car MaxP) (cadr minp))
             )
           )
    )
    (if        (or
          (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
          (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
          (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
          (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
        )
      t
    )
  )


  (setq th (getreal "\n请输入字高<1.0>"))
  (if (null th)
    (setq th 1.0)
  )

  (initget 6)
  (setq offset (getreal "\n输入偏移距离<2.0>"))
  (if (null offset)
    (setq offset 2.0)
  )


  (setq a-lst nil)
  (setq f-lst nil)
  (setq ss (ssget '((0 . "*polyline,arc,circle"))))

  (setq i 0)
  (setq l (sslength ss))
  (repeat l
    ;;repeat 1
    (setq o-lst nil)
    (repeat (setq n (sslength ss))
      ;;repeat 2
      (setq en (ssname ss (setq n (1- n))))
      (cond
        ((or (= "ARC" (cdr (assoc 0 (entget en))))
             (= "CIRCLE" (cdr (assoc 0 (entget en))))
         )
         (vla-offset (vlax-ename->vla-object en) offset)
        )
        (t
         (if (CLOCKWISEP en)
           (vla-offset (vlax-ename->vla-object en) (- offset))
           (vla-offset (vlax-ename->vla-object en) offset)
         )
        )
      )
      ;;end cond

      (vla-put-Elevation (vlax-ename->vla-object (entlast)) 0.0)
      (command "region" (entlast) "")

      (setq o-lst
             (append
               o-lst
               (list
                 (list (entlast)
                       (+ (vla-get-Elevation (vlax-ename->vla-object en))
                          (* n 0.000001)
                       )
                 )
               )
             )
      )
    )
    ;;end repeat 2

    (setq
      o-lst
       (vl-sort        o-lst
                (function (lambda (p1 p2) (> (cadr p1) (cadr p2))))
       )
    )

    (setq ss-c nil
          ss-c (ssadd)
    )

    (foreach y o-lst
      (if (>= (cadr y) (cadr (nth i o-lst)))
        (setq ss-c (ssadd (car y) ss-c))
      )
    )

    (command "subtract" (car (nth i o-lst)) "" ss-c "")

    (setq a-lst
           (append
             a-lst
             (list
               (list
                 (vla-get-area (vlax-ename->vla-object (car (nth i o-lst))))
                 (atof (rtos (cadr (nth i o-lst)) 2 2))
               )
             )
           )
    )
    (setq f-lst (append f-lst (list (entget (car (nth i o-lst))))))

    (setq ss-p (ssget "x" '((0 . "region"))))
    (command "erase" ss-p "")

    (setq i (1+ i))
  )
  ;;end repeat 1

  (setq i 0)
  (foreach x f-lst
    (entmake x)
    (setq en (entlast))
    (setq ptc (vlax-safearray->list
                (vlax-variant-value
                  (vla-get-centroid
                    (vlax-ename->vla-object en)
                  )
                )
              )

    )
    (command "text" "j" "mc" ptc th "0" (1+ i))
    (command "circle" ptc th)
    (setq i (1+ i))
  )


  (setq pt (getpoint "\n选择文字插入点:"))
  (setq vol 0.0)
  (setq i 0)
  (foreach x a-lst
    (setq vol (+ vol (* (car x) (cadr x))))
    (command "text"
             "j"
             "bl"
             (polar pt (* 1.5 pi) (* i (* 1.5 th)))
             th
             "0"
             (strcat "\nNo"
                     (rtos (1+ i) 2 0)
                     ":"
                     (rtos (car x) 2 2)
                     "*"
                     (rtos (cadr x) 2 2)
                     "="
                     (rtos (* (car x) (cadr x)) 2 2)
                     "(m3)"
             )
    )
    (setq i (1+ i))
  )

  (command "text"
           "j"
           "bl"
           (polar pt (* 1.5 pi) (* i (* 1.5 th)))
           th
           "0"
           (strcat "\nTotal volume=" (rtos vol 2 2) "(m3)")
  )

  (setvar "osmode" os)
  (princ)
)
[/code]

  • 发表于 2019-06-21 11:38
  • 阅读 ( 383 )
  • 分类:CAD插件

你可能感兴趣的文章

相关问题

0 条评论

请先 登录 后评论
老Y
老Y

38 篇文章

作家榜 »

  1. admin 184 文章
  2. 老Y 38 文章
  3. 晨曦 13 文章
  4. 陈KK 10 文章
  5. 胡亮 9 文章
  6. 肖肖 6 文章
  7. 通测工作室 4 文章
  8. boyving 3 文章