Recent Posts

Pages: 1 ... 8 9 [10]
91
I think the way you chose to display it — inside out vertically without indentation — rather than trying to replicate a visual hierarchy as I did is superior — nice, clean, uncluttered, easy to look at. 👍
92
Thanks + coolness as always = another swamp win!

An aside, I wrote the preceding when I was figuring out how to abuse the z-order of xrefs in a in highly nested hierarchy - insitu. Fun challenge. {blink}
93
Awesome as always thanks for sharing  8-)

I have something similar to get properties of nested objects:
Quote
Object Properties
3 - [ LWPOLYLINE ]
         Elevation: 0.0
         Length: 1.0
         Layer:  0
         Color:  7
         Linetype:  Continuous
         Plottable:  YES
2 - [ INSERT - Nautical Golf Course Site 2d|CROSS ]
         Objects Within Block: 4
         Layer:  Nautical Golf Course Site 2d|SHEET_GRID
         Color:  8
         Linetype:  Continuous
         Plottable:  YES
1 - [ XREF - Nautical Golf Course Site 2d ]
         Objects Within Block: 15896
         Layer:  B-Nautical|xref
         Color:  7
         Linetype:  Continuous
         Plottable:  YES
0 - [ XREF - B-Nautical ]
         Objects Within Block: 2
         Layer:  xref
         Color:  2
         Linetype:  Continuous
         Plottable:  YES
94
Potentially useful to you if you deal with a lot of nested objects -- e.g. XREFs or deeply nested block defs -- and wish to view the owner hierarchy.

Edit: Massive revamp inspired by RJP - thanks RJP!

Code: [Select]
(defun c:OBJTREE ( / mp-doc mp-get mp-get-obj-name mp-get-object-tree mp-get-owner mp-main mp-select-props-to-string mp-select-props-to-string-aux )

    (vl-load-com)
   
    (defun mp-doc ( )
        (eval
            (list
               'defun 'mp-doc nil
                (vla-get-activedocument (vlax-get-acad-object))
            )
        )
        (mp-doc)
    )
   
    (defun mp-get-owner ( object )
        (eval
            (list 'defun 'mp-get-owner '( object / owner )
                (list 'vl-catch-all-apply
                    (list 'function
                        (list 'lambda nil
                            (list 'setq 'owner
                                (list
                                    'vla-objectidtoobject
                                    (vla-get-activedocument (vlax-get-acad-object))
                                    (list 'vla-get-ownerid 'object)
                                )
                            )
                        )
                    )       
                )
               'owner
            )
        )
        (mp-get-owner object )
    )

    (defun mp-get-object-tree ( object )
        (   (lambda ( tree / owner )
                (while (setq owner (mp-get-owner (car tree)))
                    (setq tree (cons owner tree))
                )
                tree
            )
            (list object)
        )
    )
   
    (defun mp-get ( x prop / value )
        (vl-catch-all-apply 'eval '((setq value (vlax-get-property x prop))))
        (cond
            (   (null value) nil)
            (   (eq 'variant (type value)) (vlax-get x prop))
            (   (/= "OBJECTNAME" (vl-symbol-name prop)) value)
            (   (/= "AcDbBlockReference" value) (substr value 5))
            (   (eq :vlax-true
                    (vla-get-isxref
                        (vla-item (vla-get-blocks (mp-doc)) (vla-get-name x))
                    )
                )
                "ExternalReference"
            )
            (   (substr value 5)   )
        )
    )
   
    (defun mp-get-obj-name ( x / name )
        (if (setq name (mp-get x 'objectname))
            (if (wcmatch name "AcDb*")
                (substr name 5)
                name
            )   
        )
    )
   
    (defun mp-select-props-to-string-aux ( x prop pfx / label value str n )
        (if (setq value (mp-get x prop))
            (strcat
                pfx
                (if (eq 'objectname prop)
                    "Object"
                    (strcat
                        (substr (setq label (vl-symbol-name prop)) 1 1)
                        (strcase (substr label 2) t)
                    )
                )                           
                ": "
                (if (< 60 (setq n (strlen (setq str (vl-prin1-to-string value)))))
                    (strcat (substr str 1 26) " ... " (substr str (- n 26)))
                    str
                )
            )
            ""
        )   
    )   
   
    (defun mp-select-props-to-string ( x pfx )
        (strcat
            (apply 'strcat
                (cons "\n"
                    (mapcar
                        (function (lambda (p) (mp-select-props-to-string-aux x p pfx)))
                        (append
                           '(objectname handle name)
                            (if (/= (mp-get x 'name) (mp-get x 'effectivename))
                               '(effectivename)
                            )
                            (if (mp-get x 'path)
                               '(path)
                               '(isdynamicblock islayout isxref hasattributes)   
                            )
                           '(   count
                                units
                                layer
                                insertionpoint
                                startpoint
                                endpoint
                                coordinates
                                elevation
                                xscalefactor
                                yscalefactor
                                zscalefactor
                                rotation
                                color
                                linetype
                                stylename
                                height
                                tagstring
                                textstring
                            )
                        )       
                    )
                )       
            )
        )
    )

    (defun mp-main ( / pfx tab lst foo )
        (cond
            (   (null
                    (setq
                        pfx "\n    "
                        tab "    "
                        lst (nentsel "\nSelect entity: ")
                    )
                )
            )
            (   (null
                    (defun foo ( x ) ;; uses lexical globals pdx & tab
                        (princ
                            (strcat
                                "\n\nDocument: \""
                                (vla-get-fullname (mp-doc))
                                "\""
                            )
                        )
                        (defun foo ( x )
                            (princ (mp-select-props-to-string x pfx))
                            (setq pfx (strcat pfx tab))
                        )
                    )
                )
            )
            (   (eq 2 (length lst))
                (foreach x (cons 42 (mp-get-object-tree (vlax-ename->vla-object (car lst))))
                    (foo x)
                )
            )
            (   (foreach x
                    (cons 42
                        (append
                            (mp-get-object-tree
                                (mp-get-owner
                                    (car
                                        (setq lst
                                            (mapcar 'vlax-ename->vla-object
                                                (append
                                                    (reverse (last lst))
                                                    (list (car lst))
                                                )
                                            )
                                        )
                                    )
                                )
                            )
                            lst
                        )
                    )   
                    (foo x)
                )
            )
        )
        (princ)
    )
   
    ;;  Sample output:
    ;;
    ;;  Document: "D:\Clients\ME\XREF_TESTS\HOST.dwg"
    ;;
    ;;      Object: "BlockTable"
    ;;      Handle: "1"
    ;;      Count: 13
    ;;
    ;;          Object: "BlockTableRecord"
    ;;          Handle: "70"
    ;;          Name: "*Model_Space"
    ;;          Isdynamicblock: :vlax-false
    ;;          Islayout: :vlax-true
    ;;          Isxref: :vlax-false
    ;;          Count: 53
    ;;          Units: 0
    ;;
    ;;              Object: "ExternalReference"
    ;;              Handle: "3F0"
    ;;              Name: "DWG-0000"
    ;;              Path: ".\\DWG-0000.dwg"
    ;;              Layer: "0"
    ;;              Insertionpoint: (0.0 0.0 0.0)
    ;;              Xscalefactor: 1.0
    ;;              Yscalefactor: 1.0
    ;;              Zscalefactor: 1.0
    ;;              Rotation: 0.0
    ;;              Color: 256
    ;;              Linetype: "ByLayer"
    ;;
    ;;                  Object: "Text"
    ;;                  Handle: "5AD"
    ;;                  Layer: "0"
    ;;                  Insertionpoint: (-133.778 295.91 0.0)
    ;;                  Rotation: 0.0
    ;;                  Color: 2
    ;;                  Linetype: "ByLayer"
    ;;                  Stylename: "DWG-0000|Standard"
    ;;                  Height: 1.0
    ;;                  Textstring: "DWG-0000"                 

    (mp-main)

)

ObjTree {enter} Select entity: {pick entity}

Output:

Document: "D:\Clients\MP\XREF_TESTS\HOST.dwg"

    Object: "BlockTable"
    Handle: "1"
    Count: 13

        Object: "BlockTableRecord"
        Handle: "70"
        Name: "*Model_Space"
        Isdynamicblock: :vlax-false
        Islayout: :vlax-true
        Isxref: :vlax-false
        Count: 53
        Units: 0

            Object: "3dPolyline"
            Handle: "5C2"
            Layer: "0"
            Coordinates: (-117.492 293.127 0.0 -113 ... 1 0.0 -109.269 297.204 0.0)
            Color: 256
            Linetype: "ByLayer"

                Object: "3dPolylineVertex"
                Handle: "5C6"
                Layer: "0"
                Color: 256
                Linetype: "ByLayer"


Cheers.
95
AutoLISP (Vanilla / Visual) / Re: Change the value of multiple attributes
« Last post by nini007 on October 16, 2020, 02:54:21 PM »
Hello,

I allow myself to post an answer obtained on another forum (CadXp) in order to share.
The ATT_ADD lisp, below, does exactly what wanted to do.

But unfortunately I had a problem with a block that had a solid hatch in the background and the lisp was not working properly.

We must therefore do the little trick below before launching the ATT_ADD lisp.


FILLMODE = 0
RG (Regen)
Thus ALL Hatching and Flat colors "disappear"

Execution of the ATT_ADD routine ...

FILLMODE = 1
RG (Regen)
Thus ALL Hatching and Solid colors "come back"


Code: [Select]
;;
;; Commande:  ATT_ADD
;; par Gilles Chanteau (Anciennement ADDATT) - http://gilecad.azurewebsites.net/Lisp.aspx
;; Pour ajouter/soustraire une valeur numerique SIMPLE
;; a un Attribut SIMPLE sur un Bloc SIMPLE
;; Modifiée le 15/10/2020 - Luna
;; -> Ajout de la prise en compte de blocs dynamiques et modification de l'application des fonctions
;; -> Utilisation des fonctions (setpropertyvalue) et (getpropertyvalue) apparues depuis 2014 (?)

(defun c:ATT_ADD (/ Get-att-list att lst tag blc name add ss n val txt)

        (defun Get-att-list (ename / Att Att_List)

                (setq Att_List (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)))
               
        )

        (if (and
                (setq att (car (nentsel "\nSelectionnez UN Attribut a modifier: ")))
                (setq lst (entget att))
                (= (cdr (assoc 0 lst)) "ATTRIB")
                (numberp (read (cdr (assoc 1 lst))))    ;; Uniquement si le nombre correspond au premier caractère de l'attribut !
                (setq tag (cdr (assoc 2 lst)))
                (setq blc (entget (cdr (assoc 330 lst))))
                (setq name (getpropertyvalue (cdr (assoc -1 blc)) "BlockTableRecord/Name"))
                (princ "\nSelectionnez les Blocs a modifier ")
                (if (setq ss (ssget (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))))
                        (repeat (setq n (sslength ss))
                                (if (and
                                        (wcmatch (getpropertyvalue (ssname ss (setq n (1- n))) "ClassName") "AcDbAssociative*Array")
                                        (/= (getpropertyvalue (ssname ss n) "BlockTableRecord/Name") name)
                                    )
                                        (ssdel (ssname ss n) ss)
                                        (sssetfirst nil ss)
                                )
                        )
                        (princ "\nAucun jeu de sélection valide...")
                )
                (setq add (getreal "\nEntrez la valeur a ajouter ou soustraire : "))
            )
                (while (setq blc (ssname ss n))
                        (if (and
                                (assoc tag (setq att-list (get-att-list blc)))
                                (numberp (read (setq val (getpropertyvalue blc tag))))
                                (cond
                                        ((or (= (type (read val)) 'REAL) (= (type add) 'REAL))
                                                (setq txt (rtos (+ (read val) add)))
                                        )
                                        ((and (= (type (read val)) 'INT) (= (type add) 'INT))
                                                (setq txt (itoa (+ (read val) add)))
                                        )
                                )
                            )
                                (setpropertyvalue blc tag (strcat txt (vl-string-left-trim "0123456789." val)))
                        )
                        (setq n (1+ n))
                )
                (princ "\nL Objet selectionne n'est pas un attribut ! ")
        )
        (princ)

)


Meilleures salutations
96
CAD General / Re: Will your skill get you hired?
« Last post by MP on October 16, 2020, 01:09:10 PM »
Quote from: MP
My tenacious problem solving and innovation expertise does not come across on paper or map to today's HR filtering methods. Add "born with a face for radio" and a "voice for print" I'd have to reluctantly acknowledge "no". I've been steadily employed for decades strictly on word of mouth recommendations and testimonials, a strategy that is no longer in vogue. As a result have frequently considered leaving the industry to write a book for CAD support professionals who are thanklessly tasked to perform the work of dozens++ of design drafters at the eleventh miracle hour - the book I wished I had in my arsenal 20+ years ago.
97
CAD General / Re: Will your skill get you hired?
« Last post by Keith™ on October 16, 2020, 11:37:32 AM »
Do I think it is enough? Well, if you had asked me this question prior to 2010, I would have said absolutely. Regardless of it being "today's" environment, the focus has been and continues to be on removing decision making from the people who have the ability to make informed decisions and reduce everything down to some sort of metric that works for all hiring. Here is a clue: Metrics do not work, at least not in the context of having a potential employee check off a bunch of boxes. Experience counts for a whole lot more than a list of credentials and experience only counts if it comes with the understanding that experience only counts if you are doing the exact same work. Experience driving a bus for example, doesn't prepare you for driving a semi and driving a semi sure as heck doesn't prepare you for driving a school bus. The best metrics can't be reduced to a check box and therefore many employers miss out on the best employees because they insist upon looking at everything from a system of "additive qualities" that aren't really qualities at all.

So no, I wouldn't think my ability would be enough to get me hired today. It wasn't enough to get me hired in 2010 despite having more ability than the person who was hired for the job. (yeah, I followed the jobs ... I'm a stalker like that).

Plus, I have the whole age discrimination thing going against me that isn't going against me but it really is ... Oh, we have this 30 year old applicant .. lets hire them, he will be able to "grow with the company, this other dude will be retiring in a few years".

It's why I have put myself in a financial position to no longer require a job. I work because it's somethign to do.
98
AutoLISP (Vanilla / Visual) / Re: Relative paths
« Last post by PKENEWELL on October 16, 2020, 10:55:23 AM »
Thanks for providing the code.
I tried to run it after adding the path. The program was stuck though, whatever it was processing required a lot of memory. There was no error message in the command line.
The way I added the support path was: Tools, Options, Support File Search Path, Add. Added "C:\Drawing Conversion". Tried moving to the top, restarting, etc, no luck.
The only thing I could think of was adding "\\" after the "list.txt" using "strcat" ... but got an error message.

Code: [Select]
(setq pth (vl-filename-directory strcat tx1 "\\")

Like_citrus: Yes - the code you tried to add would not work - both the syntax is incorrect and you were trying to add a folder slash to the end of a full path and filename.

  • (findfile fn) returns the full path and filename of "C:\\Drawing Conversion\\list.txt" because it searches the support paths.
  • (vl-filename-directory) strips the filename off, leaving "C:\\Drawing Conversion" (without backslashes)
  • Note that the variables tx2 and tx3 are adding in the end backslashes before the sub-folders: (strcat pth "\\in\\") & (strcat pth "\\out\\"). This returns "C:\\Drawing Conversion\\in\\" & "C:\\Drawing Conversion\\out\\" respectively.

Otherwise I cannot explain what it happening. Perhaps also add the "C:\Drawing Conversion\" folder to the "Trusted Locations"?
Also - did you re-start AutoCAD after adding the support path? EDIT - OK i see you did restart AutoCAD.
Sorry - I cannot test this program because I have no DGN files to import.
99
CAD General / Re: Will your skill get you hired?
« Last post by cadtag on October 16, 2020, 08:23:56 AM »
In my experience, going back multiple decades, that's SOP for large organizations. The people who actually get the work product out the door are essential, but unimportant.  Remember that the phrase 'essential worker' bandied about during the age of covid is equivalent to 'disposable employee'.
100
CAD General / Re: CAD version without opening the drawing?
« Last post by Lonnie on October 15, 2020, 09:21:13 PM »
I believe Trueview will not only read it you can save it to an earlier version. Thinking about it I think the runtime version of Microstation will too it runs for 20 min then stops but you can get back into it right away. I use to do whole jobs with it.
Pages: 1 ... 8 9 [10]