Message 1 of 7
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
(defun ceil (x)
(if (zerop (rem x 1))
x
(+ (fix x) 1)
)
)
(defun c:HAL (/ ent entl obj layerName area sqmArea roundedArea densityValue result pt)
(cond
((not (setq ent (car (entsel "\nSelect hatch: "))))
(princ "\nNo object selected!"))
((not (eq (cdr (assoc 0 (entget ent))) "HATCH"))
(princ "\nInvalid object!"))
((setq pt (getpoint "\nSpecify first point: "))
(setq entl (entlast))
(setq obj (vlax-ename->vla-object ent))
(setq layerName (vla-get-Layer obj))
(princ (strcat "\nLayer name: " layerName))
(setq layerName (vl-string-trim " " (strcase layerName)))
(princ (strcat "\nNormalized Layer name: " layerName))
(setq densityValue
(cond
((equal layerName "S-ATR.HAL")9)
((equal layerName "S-DOD.VIS")4)
((equal layerName "S-LEU.FRU")9)
((equal layerName "S-NER.OLE")4)
((equal layerName "S-THE.PER")9)
((equal layerName "GC-AER.JAV")12)
((equal layerName "GC-ASY.GAN")12)
((equal layerName "GC-CAR.GRE")6.25); this is problem
((equal layerName "GC-CON.VIR")12)
((equal layerName "GC-RUE.CIL")9)
((equal layerName "GC-WED.TRI")9)
((equal layerName "GC-VIT.ROT")9)
((equal layerName "GR-CEN.CIL")12)
((equal layerName "GR-MUH.CAP")12)
((equal layerName "GR-PEN.SET")9)
((equal layerName "GC-ALT. GRE")10)
((equal layerName "GC-ASY. GAN")10)
((equal layerName "GR-PEN.RUB")9)
((equal layerName "GR-SPO.SPI")9)
((equal layerName "CR-BOU.BUT")9)
((equal layerName "CR-JAC.PEN")9)
(1)
)
)
(princ (strcat "\nDensity Value: " (itoa densityValue)))
(vl-cmdf "leader" pt pause pause "" "" "" densityValue)
(while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
(if (not (equal entl (setq entl (entlast))))
(progn
(setq area (vla-get-Area obj))
(setq sqmArea (/ area 1000000.0))
(setq roundedArea (ceil sqmArea))
(setq result (* densityValue roundedArea))
(princ (strcat "\nResult: " (rtos result 2 0)))
(vla-put-TextString
(vlax-ename->vla-object entl)
(strcat (rtos result 2 0) " " layerName " (" (itoa roundedArea) "m2)")
)
)
)
)
)
(princ)
)
(vl-load-com)
(princ)
________________________________________________________________________________________________________________________________________________________
(defun ceil (x)
(if (= x (fix x))
x
(1+ (fix x))
)
)
(defun get-density-value (layerName)
(cond
((equal layerName "S-ATR.hal") 9)
((equal layerName "S-DOD.vis") 4)
((equal layerName "S-LEU.fru") 9)
((equal layerName "S-NER.OLE") 4)
((equal layerName "S-THE.per") 9)
((equal layerName "GC-AER.jav") 12)
((equal layerName "GC-ASY.gan") 12)
((equal layerName "GC-CAR.gre") 6.25)
((equal layerName "GC-CON.vir")12)
((equal layerName "GC-RUE.cil") 9)
((equal layerName "GC-WED.tri") 9)
((equal layerName "GC-VIT.rot") 9)
((equal layerName "GR-CEN.cil") 12)
((equal layerName "GR-MUH.cap") 12)
((equal layerName "GR-PEN.set") 9)
((equal layerName "GC-ALT. GRE") 10)
((equal layerName "GC-ASY. GAN") 10)
((equal layerName "GR-PEN.rub") 9)
((equal layerName "GR-SPO.spi") 9)
((equal layerName "CR-BOU.but") 9)
((equal layerName "CR-JAC.pen") 9)
(1) ; Default density value if layer name doesn't match
)
)
(defun C:SHA (/ ss n1 loop laylist layer laycount layareas stringlist objcount area roundedArea hatchAreas hatchLoop hatchArea hatchRoundedArea layerTotalAreas layItem densityValue finalArea totalFinalArea)
(princ "\nSelect hatch objects to list layer counts and areas...")
(if (setq ss (ssget '((0 . "HATCH"))))
(progn
(setq n1 (sslength ss))
(setq loop 0)
(setq laylist ())
(setq laycount ())
(setq layareas ())
(setq hatchAreas ())
(setq layerTotalAreas ())
(setq totalFinalArea 0)
(textscr)
(repeat n1
(setq layer (cdr (assoc 8 (entget (ssname ss loop))))
area (vlax-get (vlax-ename->vla-object (ssname ss loop)) 'Area)
loop (1+ loop))
(if (not (member layer laylist))
(setq laylist (cons layer laylist)))
(if (assoc layer laycount)
(progn
(setq laycount (subst (cons layer (1+ (cdr (assoc layer laycount))))
(assoc layer laycount)
laycount))
(setq layareas (subst (cons layer (+ (cdr (assoc layer layareas)) area))
(assoc layer layareas)
layareas)))
(progn
(setq laycount (cons (cons layer 1) laycount))
(setq layareas (cons (cons layer area) layareas))))
(setq hatchAreas (cons (list layer area) hatchAreas))
)
(setq laylist (acad_strlsort laylist))
(foreach lay laylist
(setq objcount (cdr (assoc lay laycount))
area (cdr (assoc lay layareas))
roundedArea (ceil (/ area 1000000.0)))
(setq stringlist (strcat "\n " lay ": " (itoa objcount) " hatch(es), Actual Area: " (itoa (fix roundedArea)) "m2"))
(setq hatchLoop 0)
(foreach hatch hatchAreas
(if (equal lay (car hatch))
(progn
(setq hatchArea (cadr hatch))
(setq hatchRoundedArea (ceil (/ hatchArea 1000000.0)))
(setq stringlist (strcat stringlist "\n Hatch " (itoa (1+ hatchLoop)) " Area: " (itoa (fix hatchRoundedArea)) "m2"))
(if (setq layItem (assoc lay layerTotalAreas))
(setq layerTotalAreas (subst (cons lay (+ (cdr layItem) hatchRoundedArea)) layItem layerTotalAreas))
(setq layerTotalAreas (cons (cons lay hatchRoundedArea) layerTotalAreas)))
(setq hatchLoop (1+ hatchLoop))
)
)
)
(if (setq layItem (assoc lay layerTotalAreas))
(progn
(setq densityValue (get-density-value lay))
(setq finalArea (* (cdr layItem) densityValue))
(setq totalFinalArea (+ totalFinalArea finalArea))
(setq stringlist (strcat stringlist "\n Total Rounded-up Area for Layer " lay ": " (rtos (cdr layItem) 2 2) "m2"))
(setq stringlist (strcat stringlist "\n Density Value for Layer " lay ": " (itoa densityValue)))
(setq stringlist (strcat stringlist "\n Final Area With Density Value : >>>>>" (rtos finalArea 2 2) "m2"))
)
)
(alert stringlist)
(princ stringlist)
)
(setq stringlist (strcat "\nTotal Area of Final Areas: " (rtos totalFinalArea 2 2) "m2"))
(alert stringlist)
(princ stringlist)
)
(princ "\nNo Hatch Objects Selected..")
)
(princ)
)
(vl-load-com)
(princ)
_______________________________________________________________________________________________________________________________________________________
here i attached the drawing What i expect
Solved! Go to Solution.