Calculate Cut and Fill levels

[jason tay]

Dear Alan, i really appreciate your afford:)

:unsure:but ...as i try the result still same..

is ok Alan..sleep well ..wish u sweet dream:D

[alanjt]

Dear Alan, i really appreciate your afford:)

:unsure:but ...as i try the result still same..

is ok Alan..sleep well ..wish u sweet dream:D

Forgot to post the one where I flatten the point in sort (doesn't actually flatten the point). Update previous post. Should work now.

 

However, what I said earlier about uneven numbers still applies. Jump to the point:

Command: id
Specify point: _nod of  X = 6414.4300     Y = -7464.5722     Z = 0.0000

and erase the lone piece of text on the AS layer and give it a try.

[jason tay]

BINGO!! i had check and compare with the result using Steve lisp, it's perfect!! you are Great:shock: mate! and the time processing really fast:lol:

[alanjt]

BINGO!! i had check and compare with the result using Steve lisp, it's perfect!! you are Great:shock: mate! and the time processing really fast:lol:

 

;;; Calculate Cut/Fill of text values in drawing
;;; Required Subroutines: AT:MText
;;; Alan J. Thompson, 10.22.09
(defun c:CutFill (/ _Ins2Pnt _FlatDist _Sort #Count #Choice #SS #OGL #AS #Total)
 (vl-load-com)
 (setq _FlatPnt  (lambda (x) (list (car x) (cadr x)))
       _Ins2Pnt  (lambda (x)
                   (_FlatPnt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint x))))
                 ) ;_ lambda
       _FlatDist (lambda (x y) (distance (list (car x) (cadr x)) (list (car y) (cadr y))))
       _Sort     (lambda (l)
                   (vl-sort l
                            '(lambda (x y) (> (apply '+ (_FlatPnt (car x))) (apply '+ (_FlatPnt (car y)))))
                   ) ;_ vl-sort
                 ) ;_ lambda
       #Count    0
 ) ;_ setq
 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (initget 0 "Yes No")
 (cond
   ((and (or (setq #Choice (getkword "\nErase originals? [Yes/No] <No>: "))
             (setq #Choice "No")
         ) ;_ or
         (if (eq #Choice "No")
           (setq #SS (ssget "_X" '((0 . "TEXT") (8 . "OGL,AS"))))
           (setq #SS (ssget "_X" '((0 . "TEXT,MTEXT") (8 . "OGL,AS,CUT,FILL,TOTAL"))))
         ) ;_ if
    ) ;_ and
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (cond
        ((eq (vla-get-layer x) "OGL")
         (setq #OGL   (cons (cons (_Ins2Pnt x) (atof (vla-get-TextString x))) #OGL)
               #Count (1+ #Count)
         ) ;_ setq
        )
        ((eq (vla-get-layer x) "AS")
         (setq #AS    (cons (cons (_Ins2Pnt x) (atof (vla-get-TextString x))) #AS)
               #Count (1+ #Count)
         ) ;_ setq
        )
        ((and (eq #Choice "Yes") (vl-position (vla-get-layer x) '("CUT" "FILL" "TOTAL")))
         (vl-catch-all-apply 'vla-delete (list x))
        )
      ) ;_ cond
    ) ;_ vlax-for
    (mapcar '(lambda (n c) (vla-put-color (vla-add (vla-get-layers *AcadDoc*) n) c))
            '("CUT" "FILL" "TOTAL")
            '(1 6 2 4)
    ) ;_ mapcar
    (mapcar '(lambda (o a / #Pnt #Amt)
               (setq #Pnt (polar (list (car (car a)) (cadr (car a)))
                                 (angle (car o) (car a))
                                 (_FlatDist (car o) (car a))
                          ) ;_ polar
               ) ;_ setq
               (if (minusp (setq #Amt (- (cdr o) (cdr a))))
                 (AT:MText (car a) (rtos (abs #Amt) 2 2) 0 "CUT" 7)
                 (AT:MText (car a) (rtos #Amt 2 2) 0 "FILL" 7)
               ) ;_ if
             ) ;_ lambda
            (_Sort #OGL)
            (_Sort #AS)
    ) ;_ mapcar
    (setq #OGL   (apply '+ (mapcar 'cdr #OGL))
          #AS    (apply '+ (mapcar 'cdr #AS))
          #Total (strcat "TOTALS\\POGL: "
                         (rtos #OGL 2 2)
                         "\\PAS: "
                         (rtos #AS 2 2)
                         "\\P------------\\PDIFFERENCE: "
                         (rtos (- #OGL #AS) 2 2)
                 ) ;_ strcat
    ) ;_ setq
    (AT:MText (trans (cadr (grread T 15 0)) 1 0) #Total 0 "TOTAL" 1)
    (princ (strcat "\n" (itoa #Count) " processed."))
    (vl-catch-all-apply 'vla-delete (list #SS))
   )
 ) ;_ cond
 (princ)
) ;_ defun

[jason tay]

Below 20 second the result come out ! Cheer! Billion Thankssssss to you- Alan

[alanjt]

Below 20 second the result come out ! Cheer! Billion Thankssssss to you- Alan

You're very welcome.

It was an interesting exercise.

Glad it's working. In my benchmarking, Steve's was a lot faster, but when I went from processing a couple hundred points to processing the 15,000 I was losing accuracy. I could probably make if faster by not converting the text to vla-objects and I might do that, but you're happy.....for now.:wink:

[stevesfr]

Had a quick minute during my lunch break. Now it will place the new value below the other two values...

;;; Calculate Cut/Fill of text values in drawing
;;; Required Subroutines: AT:MText
;;; Alan J. Thompson, 10.22.09
(defun c:CutFill (/ _Ins2Pnt _FlatDist _Sort #Count #Choice #SS #OGL #AS #Total)
 (vl-load-com)
 (setq _FlatPnt  (lambda (x) (list (car x) (cadr x)))
       _Ins2Pnt  (lambda (x)
                   (_FlatPnt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint x))))
                 ) ;_ lambda
       _FlatDist (lambda (x y) (distance (list (car x) (cadr x)) (list (car y) (cadr y))))
       _Sort     (lambda (l)
                   (vl-sort l
                            '(lambda (x y) (> (apply '+ (_FlatPnt (car x))) (apply '+ (_FlatPnt (car y)))))
                   ) ;_ vl-sort
                 ) ;_ lambda
       #Count    0
 ) ;_ setq
 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (princ "\nCut and Fill Calculations")
 (initget 0 "Yes No")
 (cond
   ((and (or (setq #Choice (getkword "\nErase originals? [Yes/No] <No>: "))
             (setq #Choice "No")
         ) ;_ or
         (if (eq #Choice "No")
           (setq #SS (ssget "_X" '((0 . "TEXT") (8 . "OGL,AS"))))
           (setq #SS (ssget "_X" '((0 . "TEXT,MTEXT") (8 . "OGL,AS,CUT,FILL,TOTAL"))))
         ) ;_ if
    ) ;_ and
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (cond
        ((eq (vla-get-layer x) "OGL")
         (setq #OGL   (cons (cons (_Ins2Pnt x) (atof (vla-get-TextString x))) #OGL)
               #Count (1+ #Count)
         ) ;_ setq
        )
        ((eq (vla-get-layer x) "AS")
         (setq #AS    (cons (cons (_Ins2Pnt x) (atof (vla-get-TextString x))) #AS)
               #Count (1+ #Count)
         ) ;_ setq
        )
        ((and (eq #Choice "Yes") (vl-position (vla-get-layer x) '("CUT" "FILL" "TOTAL")))
         (vl-catch-all-apply 'vla-delete (list x))
        )
      ) ;_ cond
    ) ;_ vlax-for
    (mapcar '(lambda (n c) (vla-put-color (vla-add (vla-get-layers *AcadDoc*) n) c))
            '("CUT" "FILL" "TOTAL")
            '(1 6 2)
    ) ;_ mapcar
    (mapcar '(lambda (o a / #Pnt #Amt)
               (setq #Pnt (polar (list (car (car a)) (cadr (car a)))
                                 (* pi 1.5)
                                 (_FlatDist (car o) (car a))
                          ) ;_ polar
               ) ;_ setq
               (if (minusp (setq #Amt (- (cdr o) (cdr a))))
                 (AT:MText #Pnt (rtos #Amt 2 2) 0 "CUT" 7)
                 (AT:MText #Pnt (rtos #Amt 2 2) 0 "FILL" 7)
               ) ;_ if
             ) ;_ lambda
            (_Sort #OGL)
            (_Sort #AS)
    ) ;_ mapcar
    (setq #OGL   (apply '+ (mapcar 'cdr #OGL))
          #AS    (apply '+ (mapcar 'cdr #AS))
          #Total (strcat "TOTALS\\POGL: "
                         (rtos #OGL 2 2)
                         "\\PAS: "
                         (rtos #AS 2 2)
                         "\\P------------\\PDIFFERENCE: "
                         (rtos (- #OGL #AS) 2 2)
                 ) ;_ strcat
    ) ;_ setq
    (AT:MText (trans (cadr (grread T 15 0)) 1 0) #Total 0 "TOTAL" 1)
    (princ (strcat "\n" (itoa #Count) " processed."))
    (vl-catch-all-apply 'vla-delete (list #SS))
   )
 ) ;_ cond
 (princ)
) ;_ defun

 

 

It goes bonkers on the OGL-AS drawing. puts answers all over the place.

[alanjt]

It goes bonkers on the OGL-AS drawing. puts answers all over the place.

Err, something is funky with using polar on those objects. It was working for me, but I also experienced that problem in an earlier version. It has to have something to do with the coordinates being off by 90°. I just deleted the post, the other works just as it should. Try it.

[jason tay]

thanks stevesfr:)