(defun >> ( x ) ... )

MP_
MP_
in Programming and customization

A lot of CAD LISP programming involves examining data structures as well as entity or object data. To that end I've written various utilities over the years including object browsers that let one walk the object model in real time from object to another, displaying object properties, methods and dxf (and xdata). In the future I will post a flavor of that utility to the bricsys forums.

In the interim I'll share the following utility that I use a lot. It's simply named ">>" and can be passed just about anything, from atomic data, handles, list data, an ename or an object and will echo the (I think) appropriate data to the screen.

Examples ...

(>> '((1 2 3)(4 5 6)(7 8 9))) reports:

(1 2 3)
(4 5 6)
(7 8 9)

(>> (car (entsel))) reports:

ActiveX data:
; IAcadLine 214dbae0 : TeighaX Interface of a single line segment
;
; Property values :
;
;   Angle (RO) = 5.61321380414906
;   Application (RO) = #<VLA-OBJECT IAcadApplication 0000000023272730>
;   color = 256
;   Database (RO) = #<VLA-OBJECT IAcadDatabase 00000000215DAB48>
;   Delta (RO) = (2.08734939759036 -1.65361445783133 0.0)
;   Document (RO) = #<VLA-OBJECT IAcadDocument 0000000034357078>
;   EndPoint = (8.8643944938633 3.75451807228916 0.0)
;   EntityName (RO) = "AcDbLine"
;   EntityType (RO) = NIL
;   Handle (RO) = "78"
;   HasExtensionDictionary (RO) = 0
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000000002142FFF8>
;   Layer = "0"
;   Length (RO) = 2.66298108945025
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Material = "ByLayer"
;   Normal = (0.0 0.0 1.0)
;   ObjectID (RO) = 555376496
;   ObjectID32 (RO) = 555376496
;   ObjectName (RO) = "AcDbLine"
;   OwnerID (RO) = 876268672
;   OwnerID32 (RO) = 876268672
;   PlotStyleName = "ByLayer"
;   StartPoint = (6.77704509627294 5.40813253012048 0.0)
;   Thickness = 0.0
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000000215D8768>
;   Visible = -1
;
; Methods supported :
;
;   ArrayPolar (3)
;   ArrayRectangular (6)
;   Copy ()
;   Delete ()
;   Erase ()
;   GetBoundingBox (2)
;   GetExtensionDictionary ()
;   GetXData (3)
;   Highlight (1)
;   IntersectWith (2)
;   Mirror (2)
;   Mirror3D (3)
;   Move (2)
;   Offset (1)
;   Rotate (2)
;   Rotate3D (3)
;   ScaleEntity (2)
;   SetXData (2)
;   TransformBy (1)
;   Update ()

DXF data: 
(
    (-1 . <Entity name: 211a5f70>)
    (0 . "LINE")
    (5 . "78")
    (330 . <Entity name: 343acc80>)
    (100 . "AcDbEntity")
    (67 . 0)
    (410 . "Model")
    (8 . "0")
    (370 . -1)
    (100 . "AcDbLine")
    (10 6.77704509627294 5.40813253012048 0.0)
    (11 8.8643944938633 3.75451807228916 0.0)
    (210 0.0 0.0 1.0)
)

The block table typically sports a handle of "1", (>> "1") reports:

ActiveX data:
; IAcadBlocks 215c9e60 : TeighaX Interface of the collection of all blocks in the drawing
;
; Property values :
;
;   Application (RO) = #<VLA-OBJECT IAcadApplication 0000000023272730>
;   Count (RO) = 3
;   Database (RO) = #<VLA-OBJECT IAcadDatabase 00000000215DAB48>
;   Document (RO) = #<VLA-OBJECT IAcadDocument 0000000034357078>
;   Handle (RO) = "1"
;   HasExtensionDictionary (RO) = 0
;   ObjectID (RO) = 878309440
;   ObjectID32 (RO) = 878309440
;   ObjectName (RO) = "AcDbBlockTable"
;   OwnerID (RO) = 0
;   OwnerID32 (RO) = 0
;
; Methods supported :
;
;   Add (2)
;   Delete ()
;   Erase ()
;   GetExtensionDictionary ()
;   GetXData (3)
;   Item (1)
;   SetXData (2)

DXF data: 
(
    (-1 . <Entity name: 3459f040>)
    (0 . "TABLE")
    (2 . "BLOCK_RECORD")
    (5 . "1")
    (100 . "AcDbSymbolTable")
    (70 . 1)
)

Here's the function def:

(defun >> ( x / !! :cons-pair :dmp :dxf :point-group :tab typex ename )

    (defun !! ( x n / tab )
        (princ (strcat "\n" (setq tab (:tab n))))
        (cond
            (   (or (atom x) (:cons-pair x) (:point-group x))
                (prin1 x)
            )
            (   (princ "(")
                (foreach x x (!! x (1+ n)))
                (princ (strcat "\n" tab ")"))
            )
        )
    )

    (defun :cons-pair ( x )
        (and
            (listp x)
            (null (vl-list-length x))
        )
    )

    (defun :dmp ( x )
        (if (eq 'vla-object (type x))
            (progn
                (princ "\n\nActiveX data:")
                (vlax-dump-object x t)
            )
        )
    )

    (defun :dxf ( x / d )
        (if (eq 'ename (type x))
            (progn
                (princ "\nDXF data: ")
                (princ "\n(")
                (foreach x (entget x '("*"))
                    (!! x 1)
                )
                (princ "\n)")
            )
        )
    )

    (defun :point-group ( x / len )
        (and
            (listp x)
            (setq len (vl-list-length x))
            (eq len 4)
            (vl-every 'numberp x)
        )
    )

    (defun :tab ( n )
        ((lambda (s) (repeat n (setq s (strcat s "    "))) s) "")
    )

    (cond
        (   (eq 'ename (setq typex (type x)))
            (:dmp (vl-catch-all-apply 'vlax-ename->vla-object (list x)))
            (:dxf x)
        )
        (   (eq 'vla-object typex)
            (:dmp x)
            (:dxf (vl-catch-all-apply 'vlax-vla-object->ename (list x)))
        )
        (   (and
                (eq 'str typex)
                (setq ename (vl-catch-all-apply 'handent (list x)))
                (eq 'ename (type ename))
            )
            (>> ename)
        )
        (   (and (listp x) (vl-list-length x))
            (foreach x x
                (princ "\n")
                (princ x)
            )
        )
        (   x
            (>> (list x))
        )
    )

    (princ)

)

Command wrappers for same:

;; for primary entities
(defun c:>> ( / ename )
    (if (setq ename (car (entsel)))
        (>> ename)
    )
    (princ)        
)

;; for nested entities
(defun c:>>> ( / ename ) 
    (if (setq ename (car (nentsel)))
        (>> ename)
    )
    (princ)        
)

FWIW, cheers.

Michael.

Comments

This discussion has been closed.