Author Topic: You always look at me like I'm an object (today's freebie) ...  (Read 5506 times)

0 Members and 1 Guest are viewing this topic.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #15 on: October 19, 2020, 03:22:18 PM »
But, isn't this enough...

Code: [Select]
(defun chknestblk ( blkdef name )
  (vlax-for o blkdef
    (cond
      ( (and (= (vla-get-objectname o) "AcDbBlockTableRecord") (= (vla-get-islayout o) :vlax-false) (= (vla-get-isxref o) :vlax-false) (= (vla-get-name o) name))
        t
      )
      ( (and (= (vla-get-objectname o) "AcDbBlockTableRecord") (= (vla-get-islayout o) :vlax-false) (= (vla-get-isxref o) :vlax-false))
        (chknestblk o name)
      )
    )
  )
)
Many thanks to MP..., from a link indicated by Grrr1337 I found this Lee Mac function:
Code: [Select]
(defun blockcomponents ( blk / ent enx lst )
  (if (setq ent (tblobjname "block" blk))
    (while (setq ent (entnext ent))
      (if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
        (setq lst (vl-list* (blockcomponents (cdr (assoc 2 enx))) ent lst))
        (setq lst (cons ent lst))
      )
    )
  )
  (reverse lst)
)
Here is my solution, thanks ribarm I have not tested your function but I think it is a vla version of the same thinks, now I will try your solution:
Code: [Select]
(defun C:ALE_Block_Cmd_AddObj ( / BlkEnt ObjLst SelLst SelSet Countr EntObj TmpNam acdoc)
  (if
    (and
      (setq SelLst (entsel "Select Block:"))
      (not (prompt "\nSelect Objects to add\n"))
      (setq SelSet (ssget "_:L"))
    )
    (progn
      (setq
        acdoc  (vla-get-ActiveDocument (vlax-get-acad-object))
        BlkEnt (car SelLst)
        BlkNam (cdr (assoc 2 (entget BlkEnt)))
      )
      (prompt (strcat "\n" BlkNam))
      (and
        (ssmemb BlkEnt SelSet)
        (progn
          (setq SelSet (ssdel BlkEnt SelSet))
          (alert "The original block was also selected from the objects to be added.\nThe block selection was ignored."); > Level1
        )
      ); crash if present BlkEnt
      (repeat (setq Countr (sslength SelSet))
        (setq EntObj (vlax-ename->vla-object (ssname SelSet (setq Countr (1- Countr)))))
        (if (= "AcDbBlockReference" (vlax-get EntObj 'ObjectName))
          (if (= BlkNam (setq TmpNam (vlax-get EntObj 'Name)))
            (alert "A copy of the original block was also selected from the objects to be added.\nThe block selection was ignored."); > Level1
            (if (member BlkNam (NestedBlocks TmpNam nil))
              (alert "A copy of the original block is inside a block selected to be added.\nThe block selection was ignored."); > nested
              (setq ObjLst (cons EntObj ObjLst))
            )
          )
          (setq ObjLst (cons EntObj ObjLst))
        )
      )
      (vla-CopyObjects acdoc (vlax-make-variant  (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ObjLst)))) ObjLst))
        (vla-item (vla-get-Blocks acdoc) (cdr (assoc 2 (entget BlkEnt))))
      )
      (foreach ObjFor ObjLst (vla-delete ObjFor))
      (vla-regen acdoc acAllViewports)
    )
  )
  (princ)
)
(defun NestedBlocks (BlkNam TmpLst / EntNam EntDat TmpNam)
  (if (setq EntNam (tblobjname "BLOCK" BlkNam))
    (while (setq EntNam (entnext EntNam))
      (and
        (= "INSERT" (DXF 0 (setq EntDat (entget EntNam))))
        (not (member (setq TmpNam (DXF 2 EntDat)) TmpLst))
        (setq TmpLst (NestedBlocks TmpNam (cons TmpNam TmpLst)))
      )
    )
  )
  TmpLst
)
(defun Dxf (DxfCod EntDat)  (cdr (assoc DxfCod EntDat)))

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #16 on: October 19, 2020, 05:24:51 PM »
Don't have time to test but the anted up code by others does not appear to find all references to a block name, regardless the depth, regardless in blocks or xrefs. That's what function mp-block-names-hosting aims to do.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #17 on: October 20, 2020, 02:58:24 AM »
Don't have time to test but the anted up code by others does not appear to find all references to a block name, regardless the depth, regardless in blocks or xrefs. That's what function mp-block-names-hosting aims to do.
Thanks Michael for your time:
Code: [Select]
(ALE_Block_NestedList "a1" nil) => ("b2" "c1" "b1") - a1 = 3 blocks inside
(ALE_Block_NestedList "b1" nil) => ("c1")           - b1 = 1 blocks inside
(ALE_Block_NestedList "b2" nil) => nil              - b2 = 0 blocks inside
(ALE_Block_NestedList "c1" nil) => nil              - c1 = 0 blocks inside
;--------------------------------------------------------------------------
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(mp-block-names-hosting doc "a1")  => nil           > 1° problem
;--------------------------------------------------------------------------
(setq filter (list '(-4 . "<or") '(0 . "~INSERT") '(-4 . "<not") (cons 2 nfg) '(-4 . "not>") '(-4 . "or>")))
> 2° problem I think that the filter with ssget do not "filter" nested blocks

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #18 on: October 20, 2020, 03:24:04 AM »
But, isn't this enough...

Code: [Select]
(defun chknestblk ( blkdef name )
  (vlax-for o blkdef
    (cond
      ( (and (= (vla-get-objectname o) "AcDbBlockTableRecord") (= (vla-get-islayout o) :vlax-false) (= (vla-get-isxref o) :vlax-false) (= (vla-get-name o) name))
        t
      )
      ( (and (= (vla-get-objectname o) "AcDbBlockTableRecord") (= (vla-get-islayout o) :vlax-false) (= (vla-get-isxref o) :vlax-false))
        (chknestblk o name)
      )
    )
  )
)
Marco, sorry I am not able to use your function:
Code: [Select]
(defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
  (vl-catch-all-apply
   '(lambda ( )
      (setq VlaObj (vla-item VlaCol KeyNam))
    )
  )
  VlaObj
)


Comando: (setq blkdef (ALE_Utl_GetItem (vla-get-blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) "A1"))
#<VLA-OBJECT IAcadBlock 0000000032f59448>


Comando: (chknestblk blkdef "c1")
nil

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #19 on: October 20, 2020, 06:46:58 AM »
Actually I oversimplified...
It should just be like this :

Code: [Select]
(defun chknestblk ( blkdef name / chk blks r )

  (defun chk ( blkdef name )
    (vlax-for o blkdef
      (cond
        ( (and (= (vla-get-objectname o) "AcDbBlockReference") (= (vla-get-name o) name))
          (setq r t)
        )
        ( (= (vla-get-objectname o) "AcDbBlockReference")
          (chk (vla-item blks (vla-get-name o)) name)
        )
      )
    )
  )

  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (chk blkdef name)
  r
)

HTH.
« Last Edit: October 20, 2020, 07:21:17 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube


MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #21 on: October 20, 2020, 09:12:19 PM »
Hi Marco. My approach to your challenge was to pen a function that returned all the references (direct / indirect) to a given block name, not all the block names hosted by a block name.

To illustrate, in your sample drawing block "C1" is referenced by "B1" and "B1" is referenced by "A1". Said another way, "A1" has an instance of "B1", and "B1" has an instance of "C1".

My rationale being that if one wished to update "C1" by adding selected objects, and the selection set included instances of either "A1", "B1" or "C1" it would be doomed to failure since any one one them would cause a circular reference -- directly or indirectly.

Thus if you select a block to modify, say "C1", a selection filter was created that prevents selecting any instances of "A1", "B1", "C1". Hope that makes sense.

In your sample drawing this is what each name would return using the function I penned:

Code: [Select]
(vlax-for b (vla-get-blocks (setq doc (vla-get-activedocument (vlax-get-acad-object))))
    (if (eq :vlax-false (vla-get-islayout b))
        (princ
            (strcat
                "\n" (setq n (vla-get-name b)) ": "
                (vl-princ-to-string (mp-block-names-hosting doc n))
            )
        )
    )
    (princ)
)

B1: (A1)"B1" is referenced by "A1", or "A1" has 1 or more instances of "B1".
B2: (A1)"B2" is referenced by "A1".
A1: nil"A1" is not referenced by any non-layout blocks.
C1: (A1 B1)"C1" is referenced by "A1" & "B1".

In the latter case "B1" is direct, "A1" is indirect, as "B1" has 1 or more instances of "C1", "A1" has 1 or more instances of "B1".

An aside, the original flavor I posted would fail if there were no instances of the block you wished to revise, as it was leveraging the instancing that can be quickly lifted from the block def via dxf 331 pairs. It's been updated to use the slower - but more reliable - "iterate all child objects" technique.

While seemingly verbose, it performs reasonably fast and will also find references within XREFs. The latter can be tricky when they're nested via cascaded attaches as the nesting does not manifest via AcDbBlockReference instances but rather AbDbBlockTableRecord instances at the root level of each XREF, flagged by dxf 332 sentinels. I know, a lot to digest - sorry - don't know how to say it clearer or more concisely.

Anyway, using:

Code: [Select]
(defun mp-block-names-hosting ( doc name / get-refs find-refs mp-main )
    ;;  get nested block refs
    (defun get-refs ( b / s n d result )
        (setq s '((setq n (strcase (vla-get-name x)))))
        (vlax-for x b
            (and
                (eq "AcDbBlockReference" (vla-get-objectname x))
                (eq 'str (type (vl-catch-all-apply 'eval s)))
                (or (member n result) (setq result (cons n result)))
            )
        )
        (if (setq d (entget (vlax-vla-object->ename b)))
            (foreach e (mapcar 'cdr (vl-remove-if-not '(lambda (p) (eq 332 (car p))) d))
                (or
                    (member (setq n (strcase (cdr (assoc 2 (entget e))))) result)
                    (setq result (cons n result))
                )
            )
        )
        (if result (cons (strcase (vla-get-name b)) (reverse result)))
    )
    ;;  find nested block refs
    (defun find-refs ( lst name / n! )
        ;;  accesses lexical global var: result
        (foreach n (setq n! (car lst) lst (cdr lst))
            (cond
                ((and (/= n name) (null (member n result))))
                ((member n! result))
                ((setq result (cons n! result)))
            )
        )
    )
    ;;  wrap it up
    (defun mp-main ( blocks name / x lst result )
        (if (eq 'vla-object (type (vl-catch-all-apply 'vla-item (list blocks name))))
            (progn
                (vlax-for b blocks
                    (and
                        (eq :vlax-false (vla-get-islayout b))
                        (setq x (get-refs b))
                        (setq lst (cons x lst))
                    )
                )
                (setq lst (append (reverse lst) lst))
                (while
                    (not
                        (equal
                            (length (cdr result))
                            (progn
                                (foreach x lst (find-refs x name))
                                (length (cdr result))
                            )
                        )
                    )
                )
            )
        )
        result
    )
    ;;  pull the trigger ...
    (mp-main (vla-get-blocks doc) (strcase name))
)


A filter can be created preventing the user from selecting any blocks that would cause a circular reference to the original block insert selected:

Code: [Select]
(if
    (and
        ;; let's assume insert "B1" selected:
        (setq ent (car (entsel "Select block insert to update: ")))
        (eq "INSERT" (cdr (assoc 0 (setq data (entget ent)))))
        ;; block-name = "B1"
        (setq block-name (cdr (assoc 2 data)))
        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
        ;; nfg = ("B1" "A1"), the original block selected and "A1", since it references "B1"
        (setq nfg (cons block-name (mp-block-names-hosting doc block-name)))
        (setq nfg (substr (apply 'strcat (mapcar '(lambda (n) (strcat "," n)) nfg)) 2))
        ;; filter = ((-4 . "<or") (0 . "~INSERT") (-4 . "<not") (2 . "B1,A1") (-4 . "not>") (-4 . "or>"))
        (setq filter (list '(-4 . "<or") '(0 . "~INSERT") '(-4 . "<not") (cons 2 nfg) '(-4 . "not>") '(-4 . "or>")))
        (setq ss (ssget filter))
    )
    (progn
        (princ
            (strcat
                "\nFilter:  " (vl-prin1-to-string filter)
                "\nAllowed: " (itoa (sslength ss)) " objects"
                " that can be added to block def \"" block-name "\"."
            )
        )
        ;;  ready to roll ...
        (princ)
    )
    (princ)
)

Might report:

Filter:  ((-4 . "<or") (0 . "~INSERT") (-4 . "<not") (2 . "B1,A1") (-4 . "not>") (-4 . "or>"))
Allowed: 9 objects that can be added to block def "B1".


If you selected all visible entities.

Hope it makes sense - for what it's worth - Michael.

Revised per posts 25-27.
« Last Edit: October 22, 2020, 09:14:59 AM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #22 on: October 21, 2020, 03:05:38 AM »
Thanks again Michael for your time and patience, I believe it is a detailed explanation that will be useful to many.
Marco

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #23 on: October 21, 2020, 08:20:04 AM »
You’re most welcome my friend - hope it helps - cheers.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #24 on: October 21, 2020, 05:05:59 PM »
@MP: firstly, congrats on impressive work and a thorough explanation :-)

I may have overlooked something, but assume that block "A" is nested within block "B", and block "B" is nested within block "C", and that the supplied name argument is "A"; for mp-main to return ("B" "C") relies on the definition of "B" being encountered in the block table before "C" - is this a safe assumption to make?

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #25 on: October 21, 2020, 05:28:05 PM »
@MP: firstly, congrats on impressive work and a thorough explanation :-)

I may have overlooked something, but assume that block "A" is nested within block "B", and block "B" is nested within block "C", and that the supplied name argument is "A"; for mp-main to return ("B" "C") relies on the definition of "B" being encountered in the block table before "C" - is this a safe assumption to make?

Thanks Lee + that is correct + having mused over it means that if any block is revised after subsequent blocks are established - to reference said latter blocks - the "forward" reference(s) would elude detection with the current algorithm. tldr: algorithm is flawed = will fix when I have some play time. :)

This can be easily illustrated by nested (attached) xrefs:

    DWG-0000.dwg
        DWG-0001.dwg
            DWG-0002.dwg
                DWG-0003.dwg
                    DWG-0004.dwg
                        DWG-0005.dwg

                   
Code: [Select]
(vlax-for b (vla-get-blocks (setq doc (vla-get-activedocument (vlax-get-acad-object))))
    (if (eq :vlax-false (vla-get-islayout b))
        (princ
            (strcat
                "\n" (setq n (vla-get-name b)) ": "
                (vl-princ-to-string (mp-block-names-hosting doc n))
            )
        )
    )
    (princ)
)

Would report:

    DWG-0000: nil
    DWG-0001: (DWG-0000)
    DWG-0002: (DWG-0000 DWG-0001)
    DWG-0003: (DWG-0000 DWG-0001 DWG-0002)
    DWG-0004: (DWG-0000 DWG-0001 DWG-0002 DWG-0003)
    DWG-0005: (DWG-0000 DWG-0001 DWG-0002 DWG-0003 DWG-0004)


Which is correct.

If the entire XREF tree is bound the same code reports:

    DWG-0000: nil
    DWG-0001: (DWG-0000)
    DWG-0002: (DWG-0001)
    DWG-0003: (DWG-0002)
    DWG-0004: (DWG-0003)
    DWG-0005: (DWG-0004)


Which is incorrect.

Probably solve-able by doing at least one forward pass followed by a backward pass. Since the data could be collected on the initial pass the second pass processing time could be a fraction of the former. /thinking out loud.

tldr: Thanks for reviewing and revealing a flaw my friend!

:lol:

« Last Edit: October 22, 2020, 08:40:48 AM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: You always look at me like I'm an object (today's freebie) ...
« Reply #26 on: October 21, 2020, 08:32:42 PM »
Code revised in post #22. Good until new logic errors found. :lol:
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst