Author Topic: Challenge ( layer report )  (Read 4473 times)

0 Members and 1 Guest are viewing this topic.

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Challenge ( layer report )
« on: July 01, 2006, 08:00:04 AM »
Write a program that creates a report of all the entities/objects on a selected layer.

pseudo code

prompt user to select an entity on-screen
search dwg DB for all entities that match layer name, add to list

create report
-------------> lines (30)
-------------> plines (40)
-------------> blocks (10)
-------------> text (0)
-------------> etc.

TheSwamp.org  (serving the CAD community since 2003)

M-dub

  • Guest
Re: Challenge ( layer report )
« Reply #1 on: July 01, 2006, 08:36:17 AM »
Cool!  I can't wait to see what people come up with for this one.  Good idea, Mark!

nivuahc

  • Guest
Re: Challenge ( layer report )
« Reply #2 on: July 01, 2006, 09:04:47 AM »
I wish I had CAD at home so I could try this out. Great idea for a challenge, Mark.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Challenge ( layer report )
« Reply #3 on: July 01, 2006, 09:44:51 AM »
Code: [Select]
(defun c:test (/ x)
  (if (setq x (car (entsel "select an entity on-screen")))
    (progn
      (setq x (ACAD_STRLSORT (mapcar (function (lambda (x1) (cdr (assoc 0 (entget x1)))))
  (vl-remove-if (function listp)
    (mapcar (function cadr) (ssnamex (ssget "_X" (list (assoc 8 (entget x))))))
  ) ;_ vl-remove-if
) ;_  mapcar
      ) ;_  ACAD_STRLSORT
      ) ;_  setq
      (while x
(princ
  (strcat "\n\t" (car x) " (" (itoa (- (length x) (length (setq x (vl-remove (car x) x))))) ")")
) ;_  princ
      ) ;_  while
      (princ)
    ) ;_  progn
    (princ "\n\tNot entity selected")
  ) ;_  if
) ;_  defun

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Challenge ( layer report )
« Reply #4 on: July 01, 2006, 09:46:37 AM »
Perhaps not quite my favourite language, but pretty close ...
Code: [Select]

(DEFUN c:test ( / CNT COUNTLIST ENT FIRST LEN LST SS XL)
  (PROMPT "\n Select Entity")
  (IF (SETQ ss (SSGET "X" (LIST (ASSOC 8 (ENTGET (CAR (ENTSEL)))))))
    (PROGN (SETQ xl        (VL-SORT (MAPCAR '(LAMBDA (ent) (CDR (ASSOC 0 (ENTGET ent))))
                                            (REPEAT (SETQ len (SSLENGTH ss))
                                              (SETQ len (1- len)
                                                    lst (CONS (SSNAME ss len) lst)
                                              )
                                            )
                                    )
                                    '<
                           )
                 first     (CAR xl)
                 countlist '()
                 cnt       0
           )
           (FOREACH x xl
             (IF (= x first)
               (SETQ cnt (1+ cnt))
               (PROGN (IF first
                        (SETQ countlist (CONS (CONS first cnt) countlist)
                              first     x
                              cnt       1
                        )
                      )
               )
             )
           )
           (SETQ countlist (CONS (CONS first cnt) countlist))
    )
  )
  (FOREACH pair countlist
    (PROMPT (STRCAT "\n" (CAR pair) "  :\t" (ITOA (CDR pair))))
  )
  (princ)
)

edit : Tart-up tabs
« Last Edit: July 01, 2006, 10:09:16 AM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Re: Challenge ( layer report )
« Reply #5 on: July 01, 2006, 09:50:57 AM »
You guys are amazing! Those programs are very fast.  :-o
TheSwamp.org  (serving the CAD community since 2003)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Challenge ( layer report )
« Reply #6 on: July 01, 2006, 10:38:09 AM »
Has found a bug...
I correct - move (princ):
Code: [Select]
(defun c:test (/ x)
  (if (setq x (car (entsel "select an entity on-screen")))
    (progn
      (setq x (ACAD_STRLSORT (mapcar (function (lambda (x1) (cdr (assoc 0 (entget x1)))))
  (vl-remove-if (function listp)
    (mapcar (function cadr) (ssnamex (ssget "_X" (list (assoc 8 (entget x))))))
  ) ;_ vl-remove-if
) ;_  mapcar
      ) ;_  ACAD_STRLSORT
      ) ;_  setq
      (while x
(princ
  (strcat "\n\t" (car x) " (" (itoa (- (length x) (length (setq x (vl-remove (car x) x))))) ")")
) ;_  princ
      ) ;_  while
    ) ;_  progn
    (princ "\n\tNot entity selected")
  ) ;_  if
  (princ)
) ;_  defun

Glenn R

  • Guest
Re: Challenge ( layer report )
« Reply #7 on: July 04, 2006, 08:30:44 PM »
Code: [Select]
// Define Command "LayerReport"
[CommandMethod("LayerReport")]
static public void LayerReportCommand() {
// Get a pointer to the currently active document...
Document currentDocument = acadApp.DocumentManager.MdiActiveDocument;
//...and a pointer to the currently active documents database...
Database currentDatabase = currentDocument.Database;
//...and the editor whilst we're at it...
Editor ed = currentDocument.Editor;

PromptEntityOptions promptEntOpts = new PromptEntityOptions("Select an entity: ");
// Ask the question...
PromptEntityResult promptEntRes = ed.GetEntity(promptEntOpts);
// Did we succeed?
if (promptEntRes.Status != PromptStatus.OK)
return; // Nope - bailski!

// Kick off a transaction on the dbase...
using (Transaction tr = currentDocument.TransactionManager.StartTransaction()) {
// Open up the selected entity for a read op only...
Entity selectedEntity = tr.GetObject(promptEntRes.ObjectId, OpenMode.ForRead, false) as Entity;
// Did we get it?
if (selectedEntity == null)
return;
// Get the layer of the entity...
string selectedEntityLayerName = selectedEntity.Layer;
// Now we loop the block table looking for entities that have the same layer.
// Open the block table for read...
BlockTable blkTbl = tr.GetObject(currentDatabase.BlockTableId, OpenMode.ForRead, false) as BlockTable;
// Did we get it?
if (blkTbl == null)
return; // Nope - out we go!

// Declare our hashtable for storing out stuff
Hashtable layerReportTable = null;
// Loop the table...
foreach (ObjectId blkTblRcdId in blkTbl) {
BlockTableRecord blkTblRcd = tr.GetObject(blkTblRcdId, OpenMode.ForRead, false) as BlockTableRecord;
if (blkTblRcd == null)
continue; // Failed to open it for some reason
// Loop all the entities in the block table record.
// This approach will inherently get ALL entities in the dbase...
foreach (ObjectId entityId in blkTblRcd) {
Entity blkTblRcdEntity = tr.GetObject(entityId, OpenMode.ForRead, false) as Entity;
if (blkTblRcdEntity == null)
continue; // Failed to get entity in block table record for some reason.
// Is it on the same layer as the originally selected entity?
if (blkTblRcdEntity.Layer == selectedEntityLayerName) {
if (layerReportTable == null)
layerReportTable = new Hashtable();
// Yep - got a match! Print up the entity type
Type entityType = blkTblRcdEntity.GetType();
// Does our table contain the object type already?
if (!layerReportTable.ContainsKey(entityType))
layerReportTable.Add(entityType, 1); // No, so add it in.
else // Yes, so increment the count.
layerReportTable[entityType] = (int)layerReportTable[entityType] + 1;
}//if
}//foreach
}//foreach

// Did we get anything?
if (layerReportTable != null && layerReportTable.Count > 0)
//  print out the results...
ed.WriteMessage("\nEntities on layer {0}: ", selectedEntityLayerName);
foreach (DictionaryEntry de in layerReportTable)
ed.WriteMessage("\n{0} : {1}", de.Key, de.Value);

// Last off commit the transaction, although not strictly necessary.
tr.Commit();

}//using
}

Cheers,
Glenn.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Challenge ( layer report )
« Reply #8 on: July 06, 2006, 12:36:04 PM »
Here is mine.  Been out sick.

Code: [Select]
(defun FindObjOnLayer (Doc LayName / ObjList tmpList ObjName)

(vlax-for Lo (vla-get-Layouts Doc)
 (vlax-for Obj (vla-get-Block Lo)
  (if (= (strcase (vla-get-Layer Obj)) (strcase LayName))
   (if (setq tmpList (assoc (setq ObjName (vla-get-ObjectName Obj)) ObjList))
    (setq ObjList (subst (cons ObjName (1+ (cdr tmpList))) (assoc ObjName ObjList) ObjList))
    (setq ObjList (cons (cons ObjName 1) ObjList))
   )
  )
 )
)
;(print ObjList)
(foreach i ObjList
 (prompt (strcat "\n Object type \"" (substr (car i) 5) "\" (" (itoa (cdr i)) ")"))
)
(princ)
)

Can be used with ObjectDBX.  Called like (for active drawing)

Code: [Select]
(FindObjOnLayer
 (vla-get-ActiveDocument (vlax-get-Acad-Object))
 (cdr (assoc 8 (entget (car (entsel)))))
)

Return looks like
Quote
Command: (FindObjOnLayer
(_>  (vla-get-ActiveDocument (vlax-get-Acad-Object))
(_>  (cdr (assoc 8 (entget (car (entsel)))))
(_> )

Select object:
 Object type "Polyline" (14)
 Object type "Arc" (3)
 Object type "Circle" (17)
 Object type "Line" (14)
 Object type "BlockReference" (48)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Challenge ( layer report )
« Reply #9 on: July 06, 2006, 01:12:47 PM »
Ok, here is my pure lisp .. will work on all AutoCAD versions supporting lisp

Code: [Select]
(DEFUN C:LAYREPORT( / delset elay etype slen sset )
  ;;;grab an object layer
  (setq elay (cdr (assoc 8 (entget (car (entsel))))))
  ;;;grab all objects on that layer
  (setq sset (ssget "x" (list (cons 8 elay))))
  ;;;cycle through the selection set while we still have one
  (while (>(sslength sset) 0)
    ;;;grab the entity type of the first object
    (setq etype (cdr (assoc 0 (entget (ssname sset 0)))))
    ;;;count all objects of that type on the specified layer in the drawing
    (setq slen (sslength (setq delset (ssget "x" (list (cons 0 etype)(cons 8 elay))))))
    ;;;put the data in an output format
    (princ (strcat "\n--------->" etype "(" (itoa slen) ")"))
    ;;;cylcel through our selection set while we still have one
    (while (>(sslength delset) 0)
      ;;;decrement the main selection set
      (setq sset (ssdel (ssname delset 0) sset))
      ;;;decrement our specific object selection set
      (setq delset (ssdel (ssname delset 0) delset))
    )
  )
  ;;;exit quietly
  (princ)
)

output =
Quote
--------->INSERT(38)
--------->MTEXT(35)
--------->LEADER(4)
--------->LINE(57)
--------->SOLID(7)
--------->TEXT(276)
--------->LWPOLYLINE(4)
--------->CIRCLE(19)
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Challenge ( layer report )
« Reply #10 on: July 06, 2006, 05:15:26 PM »
Nothing original from me, just another perspective, I like Keith's a lot.
Code: [Select]
(defun c:layreport (/ delset elay etype ent sset)
  (setq elay (cdr (assoc 8 (entget (car (entsel))))))
  (setq sset (ssget "x" (list (cons 8 elay))))
  (while (setq ent (ssname sset 0))
    (setq etype (cdr (assoc 0 (entget (ssname sset 0)))))
    (setq delset (ssget "x" (list (cons 0 etype) (cons 8 elay))))
    (princ (strcat "\n--------->" etype "(" (itoa (sslength delset)) ")"))
    (while (setq ent (ssname delset 0))
      (ssdel ent sset)
      (ssdel ent delset)
    )
  )
  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Challenge ( layer report )
« Reply #11 on: July 07, 2006, 12:50:52 AM »
(entsel) - >> NIL ? ? ?  :-(

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Challenge ( layer report )
« Reply #12 on: July 07, 2006, 12:58:09 AM »
Didn't say it was fool proof. :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Challenge ( layer report )
« Reply #13 on: July 07, 2006, 01:07:44 AM »
I always do check of function ENTSEL..   :-)
Code: [Select]
(if (setq x (car (entsel "select an entity on-screen")))
   (progn
      (................................

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Challenge ( layer report )
« Reply #14 on: July 07, 2006, 02:10:19 AM »
Code: [Select]
(defun c:foo ( / ename result tally )
    (if (setq ename (car (entsel)))
        (foreach key
            (mapcar
               '(lambda (tuple) (cdr (assoc 0 (entget (cadr tuple)))))
                (ssnamex (ssget "x" (list (assoc 8 (entget ename)))))
            )
            (setq result
                (if (setq tally (assoc key result))
                    (subst (cons key (1+ (cdr tally))) tally result)
                    (cons (cons key 1) result)
                )
            )   
        )
    )   
    (mapcar 'print (vl-sort result '(lambda (a b) (< (car a) (car b)))))
    (princ)
)

Must give a nod to Evgeniy who utilized (ssnamex ...) first.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Challenge ( layer report )
« Reply #15 on: July 07, 2006, 08:03:49 AM »
OK Evgeniy, thanks for keeping me honest. 8-)
Code: [Select]
(defun c:layreport (/ delset elay etype ent sset)
  (and
    (setq ent (car (entsel)))
    (setq sset (ssget "x" (list (cons 8 (setq elay (cdr (assoc 8 (entget ent))))))))
    (while (setq ent (ssname sset 0))
      (setq etype (cdr (assoc 0 (entget (ssname sset 0)))))
      (setq delset (ssget "x" (list (cons 0 etype) (cons 8 elay))))
      (princ (strcat "\n--------->" etype "(" (itoa (sslength delset)) ")"))
      (while (setq ent (ssname delset 0))
        (ssdel ent sset)
        (ssdel ent delset)
      )
    )
  )
  (princ)
)

Outstanding as always Michael.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.