What i mistake ? Real value not Accepted ?

What i mistake ? Real value not Accepted ?

jaimuthu
Advocate Advocate
493 Views
6 Replies
Message 1 of 7

What i mistake ? Real value not Accepted ?

jaimuthu
Advocate
Advocate
(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 

0 Likes
Accepted solutions (1)
494 Views
6 Replies
Replies (6)
Message 2 of 7

Moshe-A
Mentor
Mentor

@jaimuthu ,

 

this line ent should be entl?

 

(setq obj (vlax-ename->vla-object ent))

 

moshe

0 Likes
Message 3 of 7

ec-cad
Collaborator
Collaborator

May be this line:

(setq stringlist (strcat stringlist "\n    Density Value for Layer " lay ": " (itoa densityValue)))

Where (itoa densityValue) might need to be (rtos densityValue 2 2) 

ECCAD

0 Likes
Message 4 of 7

paullimapa
Mentor
Mentor
Accepted solution

 

((equal layerName "GC-CAR.GRE")6.25); this is problem

Any time you introduce a decimal in a number then this is no longer an integer but becomes a real number.

So everywhere you reference densityValue as an integer will have to change like line 58:

 

(princ (strcat "\nDensity Value: " (itoa densityValue)))

 

One way to get around this is to test densityValue to see what kind of number it is and then code accordingly:

 

(cond ; test densityValue
 ((eq (type densityValue) 'INT) ; if integer
  (princ (strcat "\nDensity Value: " (itoa densityValue))) ; use itoa
 )
 ((eq (type densityValue) 'REAL) ; if real
  (princ (strcat "\nDensity Value: " (rtos densityValue 2 2))) ; use rtos
 )
) ; cond​

 

 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 5 of 7

komondormrex
Mentor
Mentor

komondormrex_0-1722366874178.png

you cannot  itoa decimal number, use rtos instead

0 Likes
Message 6 of 7

ec-cad
Collaborator
Collaborator

Paullimapa,

Probably good to 'test', but try the following sequence.

Command: (setq a 1)
1
Command: (setq b (rtos a 2 2)) ; returns "1"
"1"
Command: (type a)
INT

 

0 Likes
Message 7 of 7

Kent1Cooper
Consultant
Consultant

@ec-cad wrote:

....

Command: (setq a 1)

1
Command: (setq b (rtos a 2 2)) ; returns "1"
"1"

....


That depends on the setting of your DIMZIN System Variable.  For me, with DIMZIN = 0:

Command: (setq b (rtos a 2 2))
"1.00"

Kent Cooper, AIA
0 Likes