TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Fabricio28 on August 09, 2013, 12:12:01 PM
-
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)
)
-
All SOLIDS.
-
All SOLIDS.
convert solids to plines for area calcs
;;; Convert solid to pline, inspired by post:
;;; From: Alex Schamenek (Aschamen@yahoo.com)
;;; Subject: Re: Solid object to Polyline
;;; Newsgroups: autodesk.autocad.customization
;;; Date: 2001-09-18 12:08:28 PST
(defun-q c:Solid2Pline (/ ss i solid pt1 pt2 pt3 pt4 ed dlay)
(setq ss (ssget '((0 . "SOLID"))))
(if ss
(progn (setq i 0)
(repeat (sslength ss)
(SETQ Solid (ssname ss i)
pt1 (trans (cdr (assoc 10 (entget solid))) 0 1)
pt2 (trans (cdr (assoc 11 (entget solid))) 0 1)
pt3 (trans (cdr (assoc 12 (entget solid))) 0 1)
pt4 (trans (cdr (assoc 13 (entget solid))) 0 1)
);SETQ
(setq ed (entget solid)
elay (cdr (assoc 8 ed))
) ;_setq
(setvar "CLAYER" elay)
(COMMAND "_.PLINE" PT1 PT2 PT4 PT3 "C")
(command ".erase" solid "")
(setq i (1+ i))
) ;_ repeat
) ;_ progn
) ;_ if
(princ (strcat "\n" (itoa i) " Solids converted to LwPolylines"))
(princ)
) ;_ defun
-
@danallen
Works Perfect!
Many Thanks
I have a question...
All SOLIDS.
SOLIDS isn't a kind of hatch?
-
I have a question...
SOLIDS isn't a kind of hatch?
no, solids are an autocad object just like lines, circles, etc
they can have either 3 or 4 points
-
All SOLIDS.
convert solids to plines for area calcs
;;; Convert solid to pline, inspired by post:
;;; From: Alex Schamenek (Aschamen@yahoo.com)
;;; Subject: Re: Solid object to Polyline
;;; Newsgroups: autodesk.autocad.customization
;;; Date: 2001-09-18 12:08:28 PST
(defun-q c:Solid2Pline (/ ss i solid pt1 pt2 pt3 pt4 ed dlay)
(setq ss (ssget '((0 . "SOLID"))))
(if ss
(progn (setq i 0)
(repeat (sslength ss)
(SETQ Solid (ssname ss i)
pt1 (trans (cdr (assoc 10 (entget solid))) 0 1)
pt2 (trans (cdr (assoc 11 (entget solid))) 0 1)
pt3 (trans (cdr (assoc 12 (entget solid))) 0 1)
pt4 (trans (cdr (assoc 13 (entget solid))) 0 1)
);SETQ
(setq ed (entget solid)
elay (cdr (assoc 8 ed))
) ;_setq
(setvar "CLAYER" elay)
(COMMAND "_.PLINE" PT1 PT2 PT4 PT3 "C")
(command ".erase" solid "")
(setq i (1+ i))
) ;_ repeat
) ;_ progn
) ;_ if
(princ (strcat "\n" (itoa i) " Solids converted to LwPolylines"))
(princ)
) ;_ defun
awesome. this work for me.
but what about SOLIDs in NESTED BLOCKS.