HOW TOTAL BLT_UP_AREA SUBTRACT DEDUCT AREA ?

HOW TOTAL BLT_UP_AREA SUBTRACT DEDUCT AREA ?

jaimuthu
Advocate Advocate
831 Views
12 Replies
Message 1 of 13

HOW TOTAL BLT_UP_AREA SUBTRACT DEDUCT AREA ?

jaimuthu
Advocate
Advocate
(defun c:BA (/ totalArea)
  (setq totalArea 0.0)
  (setq searchString "BLT_UP_AREA")
  (setq deductString "deduct")
  (setq messageText "")

  (vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (if (or (wcmatch (vla-get-name lay) (strcat "*" searchString "*"))
            (wcmatch (vla-get-name lay) (strcat "*" deductString "*")))
      (progn
        (setq ss (ssget "X" (list (cons 8 (vla-get-name lay)))))
        (if ss
          (progn
            (setq area 0.0)
            (setq i 0)
            (while (< i (sslength ss))
              (setq ent (ssname ss i))
              (setq area (+ area (vla-get-area (vlax-ename->vla-object ent))))
              (setq i (1+ i))
            )
            (setq messageText (strcat messageText "\n Area for '" (vla-get-name lay) "': " (rtos area 2 2)))
            (setq totalArea (+ totalArea area))
          )
        )
      )
    )
  )

  (if (> totalArea 0.0)
    (progn
      (setq messageText (strcat messageText "\n Total Area: " (rtos totalArea 2 2)))
    )
    (setq messageText (strcat messageText "\n No objects found on layers containing '" searchString "' or '" deductString "'"))
  )

  (alert messageText)
  (princ)
)
0 Likes
Accepted solutions (2)
832 Views
12 Replies
Replies (12)
Message 2 of 13

EnM4st3r
Advocate
Advocate

maybe like this?

 

Edit: *deleted code*

 

 

 

0 Likes
Message 3 of 13

jaimuthu
Advocate
Advocate

; error: no function definition: nil

0 Likes
Message 4 of 13

EnM4st3r
Advocate
Advocate
Accepted solution

ah there was a typo.

 

 

 

(defun c:BA (/ totalArea totaldeductarea searchString deductString messageText area  deductarea) 
  
  (setq totalArea       0.0
        totaldeductarea 0.0
        searchString    "BLT_UP_AREA"
        deductString    "DEDUCT"
        messageText     ""
  )

  (vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) 
    (cond 
      ((wcmatch (vla-get-name lay) (strcat "*" searchString))
        (if (not (numberp (setq area (getarea lay)))) (setq area 0.0))     
        (setq messageText (strcat messageText "\n Area for '"(vla-get-name lay) "': " (rtos area 2 2))
              totalArea   (+ area totalArea)
        )
      )
      ((wcmatch (vla-get-name lay) (strcat "*" searchString "*" deductString))
        (if (not (numberp (setq deductarea (getarea lay)))) (setq deductarea 0.0))
        (setq messageText     (strcat messageText  "\n Area for '" (vla-get-name lay) "': " (rtos deductarea 2 2))
              totaldeductarea (+ totaldeductarea deductarea)
        )
      )
    )
  )
  
  (alert (strcat " Total Builtup area (Without Deduct) --- > " (RTOS totalArea 2 2)))

  (alert (strcat " Total Deduct area --- > " (RTOS totaldeductarea 2 2)))

  (setq totalArea (- totalArea totaldeductarea))
  (if (> totalArea 0.0) 
      (setq messageText (strcat messageText "\n Final Builtup Area With Deduct --- >: " (rtos totalArea 2 2)))
    (setq messageText (strcat messageText  "\n No objects found on layers containing '" searchString "' or '" deductString "'"))
  )
  
  (alert messageText)
  (princ)
)

(defun getarea (layer / ss i ent area) 
  (setq ss (ssget "X" (list (cons 8 (vla-get-name layer)))))
  (if ss 
    (progn 
      (setq i    0
            area 0.0
      )
      (while (< i (sslength ss)) 
        (setq ent (ssname ss i))
        (setq area (+ area (vla-get-area (vlax-ename->vla-object ent))))
        (setq i (1+ i))
      )
    )
  )
  area
)
0 Likes
Message 5 of 13

jaimuthu
Advocate
Advocate

its work on previous i attached file but  now it did not work for this atached file ; error: no function definition: GETAREA

0 Likes
Message 6 of 13

jaimuthu
Advocate
Advocate
; error: no function definition: GETAREA
0 Likes
Message 7 of 13

EnM4st3r
Advocate
Advocate

ah i forgot that in the messasge. Put this at the end:

(defun getarea (layer / ss i ent area)
  (setq ss (ssget "X" (list (cons 8 (vla-get-name layer)))))
  (if ss
    (progn
      (setq i 0
            area 0.0
      )
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (setq area (+ area (vla-get-area (vlax-ename->vla-object ent))))
        (setq i (1+ i))
      )
    )
  )
  area
)




0 Likes
Message 8 of 13

jaimuthu
Advocate
Advocate

 

; error: bad argument type: numberp: nil

0 Likes
Message 9 of 13

jaimuthu
Advocate
Advocate
i put at end ; error: bad argument type: numberp: nil
(defun c:BA (/ totalArea totaldeductarea searchString deductString messageText area deductarea)
(setq totalArea 0.0
totaldeductarea 0.0
searchString "BLT_UP_AREA"
deductString "DEDUCT"
messageText ""
)

(vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(cond
((wcmatch (vla-get-name lay) (strcat "*" searchString))
(setq area (getarea lay)
messageText (strcat messageText "\n Area for '" (vla-get-name lay) "': " (rtos area 2 2))
totalArea (+ area totalArea)
)
)
((wcmatch (vla-get-name lay) (strcat "*" searchString "*" deductString))
(setq deductarea (getarea lay)
messageText (strcat messageText "\n Area for '" (vla-get-name lay) "': " (rtos deductarea 2 2))
totaldeductarea (+ totaldeductarea deductarea)
)
)
)
)



(alert (strcat " Total Builtup area (Without Deduct) --- > " (RTOS totalArea 2 2)))

(alert (strcat " Total Deduct area --- > " (RTOS totaldeductarea 2 2)))

(setq totalArea (- totalArea totaldeductarea))
(if (> totalArea 0.0)
(progn
(setq messageText (strcat messageText "\n Final Builtup Area With Deduct --- >: " (rtos totalArea 2 2)))
)
(setq messageText (strcat messageText "\n No objects found on layers containing '" searchString "' or '" deductString "'"))
)


(alert messageText)
(princ)




)
(defun getarea (layer / ss i ent area)
(setq ss (ssget "X" (list (cons 8 (vla-get-name layer)))))
(if ss
(progn
(setq i 0
area 0.0
)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq area (+ area (vla-get-area (vlax-ename->vla-object ent))))
(setq i (1+ i))
)
)
)
area
)
0 Likes
Message 10 of 13

EnM4st3r
Advocate
Advocate
Accepted solution

that is because there are layers that get evaluated without any objects/area in the drawing. 

 

I editet the post you marked as Solution to take this into account, see if this works.

0 Likes
Message 11 of 13

jaimuthu
Advocate
Advocate

thanks

0 Likes
Message 12 of 13

jaimuthu
Advocate
Advocate
(defun c:FSI (/ totalArea totalDeductArea searchString deductStrings messageText area plotBoundaryArea)
  (setq totalArea 0.0
        totalDeductArea 0.0
        searchString "BLT_UP_AREA"
        deductStrings '("STILT_PARKING" "COVERED_PARKING" "DEDUCT" "HEADROOM")
        messageText ""
  )

  ; Calculate the total area and deduct area
  (vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (if (wcmatch (vla-get-name lay) (strcat "*" searchString))
      (progn
        (setq area (getarea lay)
              messageText (strcat messageText "\n Builtup Area ----> '" (vla-get-name lay) "': " (rtos area 2 2)" SQ.M "  " \n " 

	 (RTOS(* area 10.764) 2 2)" SQ.FT "); SQM TO SQ.FT CONVERT VALUE 10.764)
	      
              totalArea (+ area totalArea)
        )
      )
    )

    (foreach deductString deductStrings
      (if (wcmatch (vla-get-name lay) (strcat "*" deductString))
        (progn
          (setq deductarea (getarea lay)
                messageText (strcat messageText "\n Non FSI Area ----> '" (vla-get-name lay) "': " (rtos deductarea 2 2)" SQ.M "  " \n " 

	 (RTOS(* deductarea 10.764) 2 2)" SQ.FT "); SQM TO SQ.FT CONVERT VALUE 10.764))
                totalDeductArea (+ deductarea totalDeductArea)
          )
        )
      )
    )
  )

  (setq totalArea (- totalArea totalDeductArea))
  (if (> totalArea 0.0)
    (setq messageText (strcat messageText "\n Final FSI Area  --- >: " (rtos totalArea 2 2)" SQ.M "  " \n " 

	 (RTOS(* totalArea 10.764) 2 2)" SQ.FT "); SQM TO SQ.FT CONVERT VALUE 10.764))
    )
    (setq messageText (strcat messageText "\n No objects found on layers containing '" searchString "' or deduct layers"))
  )

  ; Calculate the area for the "PLOT_BOUNDARY" layer
  (setq plotBoundaryLayerName "PLOT_BOUNDARY")
  (setq plotBoundaryArea (getlayerarea plotBoundaryLayerName))
  
  (if (= plotBoundaryArea 0.0)
    (setq messageText (strcat messageText "\n No objects found on the '" plotBoundaryLayerName "' layer"))
    (setq messageText (strcat messageText "\n PLOT AREA----> '" plotBoundaryLayerName "': " (rtos plotBoundaryArea 2 2)" SQ.M " "\n "

	 (RTOS(* plotBoundaryArea 10.764) 2 2)" SQ.FT "); SQM TO SQ.FT CONVERT VALUE 10.764)) ))
  ))

  (alert (strcat " Total Builtup area (Without Deduct) --- > " (rtos totalArea 2 2)  " SQ.M "  "     \n "

	 (RTOS(* totalArea 10.764) 2 2)" SQ.FT "); SQM TO SQ.FT CONVERT VALUE 10.764

	 )
  (alert (strcat " Total Non FSI Area --- > " (rtos totalDeductArea 2 2)" SQ.M "  "     \n "

	 (RTOS(* totalDeductArea 10.764) 2 2)" SQ.FT "); SQM TO SQ.FT CONVERT VALUE 10.764))

	 )

	 (alert messageText)

	 (alert (strcat "FLOOR SPACE INDEX = " (rtos (/ totalArea plotBoundaryArea) 2 2)" % " ))
         (VL-VBALOAD "D:/EPLAN/INFO.DVB")
         (VL-VBARUN "INFO")

  (princ)
)

(defun getarea (layer / ss i ent area)
  (setq ss (ssget "X" (list (cons 8 (vla-get-name layer))))
        area 0.0
  )
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (setq obj (vlax-ename->vla-object ent))

        ;; Check if the object has a property named "Area"
        (if (vlax-property-available-p obj 'Area)
          (setq area (+ area (vla-get-Area obj)))
        )

        (setq i (1+ i))
      )
    )
  )
  area
)
THIS CODE I RUN SOME TIMES ITS WORK FINE MANY TIMES  Command: FSI
; error: no function definition: GETLAYERAREA
0 Likes
Message 13 of 13

EnM4st3r
Advocate
Advocate

in line 48 you try using a function called "getlayerarea". But this function is not defined in the code.
I guess you want to use the "getarea" function here?

0 Likes