Hi guys,
I'm trying to create a area table for 2 hatches. I'm using HatchTAble.lsp from Pbe.
But didn't work, I think isn't a hatch.
I've attached the dwg file.
I'd like to know the total area yellow and gray.
(Defun c:HatchTAble ( / AllData ss e edata Area_table crow bn area_ ssNH)
(vl-load-com)
;;; pBe 23Apr2013 ;;;
(if
(setq AllData nil ssNH (ssadd)
ss (ssget '((0 . "Hatch")))
)
(progn
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(setq edata
(list
(vlax-get e 'Color)
(IF
(not
(vl-catch-all-error-p
(setq area_ (vl-catch-all-apply 'vla-get-area (list E)))
)
)
area_
(progn (ssadd (ssname ss i) ssNH) 0.0)
)
)
)
(setq AllData
(if (setq f (assoc (car edata) AllData))
(subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata)
(cons edata AllData)
)
)
)
(setq AllData (vl-sort AllData '(lambda (m n) (> (Cadr m) (cadr n)))))
(setq Area_table
(vlax-invoke
(vlax-get (vla-get-ActiveLayout
(vla-get-activedocument (vlax-get-acad-object))
)
'Block
)
'Addtable
(getpoint "\nPick point for Table:")
2 2 50 275
)
)
(vla-settext Area_table 0 0 "Area Tabulation")
(vla-setcelltextheight Area_table 0 0 20.0)
(mapcar '(lambda (y)
(vla-settext Area_table 1 (car y) (cadr y))
(vla-setcelltextheight Area_table 1 (car y) 20.0)
)
(list '(0 "Area") '(1 "Color"))
)
(foreach d AllData
(vla-insertrows
Area_table
(1+ (setq crow (vla-get-rows Area_table)))
50
1
)
(vla-setCellValue Area_table crow 0 (cadr d))
(vla-setcelltextheight Area_table crow 0 20.0)
(vla-setCellAlignment Area_table crow 0 5)
(vla-setcellformat Area_table crow 0 "%lu2%pr2%th44")
(if (tblsearch "BLOCK" (setq bn (strcat "Zone " (itoa (Car d)))))
(progn
(vla-setCellType Area_table crow 1 acBlockCell)
(vla-SetBlockTableRecordId
Area_table
crow
1
(vla-get-objectID
(vla-item
(vla-get-blocks
(vla-get-activedocument
(vlax-get-acad-object)
)
)
bn
)
)
:vlax-true
)
(vla-setAutoScale Area_table crow 1 :vlax-false)
(vla-setBlockScale Area_table crow 1 0.85)
(vla-setCellAlignment Area_table crow 1 5)
)
(princ (Strcat "\nBlock " bn " Not Found"))
)
) (sssetfirst nil ssNH)
)
)
(princ)
)
