Topic: Removing ALL hyperlinks

[ian50]

From time to time we receive drawings from Architects to use as base plans which are full of hyperlinks, which are distracting when your crosshairs continually flash up the www icon. I know that this can be switched off in options, but is there a way in lisp to remove/purge ALL hyperlinks to get rid of them once and for all...??

I've tried the -hyperlink "r" option but this doesn't seem to pick up nested entities. I've also noticed that in some of the blocks the hyperlink isn't associated with a particular sub-entity, it appears that the block has been manually edited through the block editor and the hyperlink set using the properties pallette?

My knowledge of lisp is limited, so any assistance would be appreciated.

[Lee Mac]

Try the following:

Code: [Select]

(defun c:delhyp nil
    (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk (vlax-map-collection (vla-get-hyperlinks obj) 'vla-delete))
        )
    )
    (princ)
)
(vl-load-com) (princ)
Or, a more verbose version with user feedback:

Code: [Select]

(defun c:delhyp ( / cnt )
    (setq cnt 0)
    (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk
                (vlax-map-collection (vla-get-hyperlinks obj)
                    (function
                        (lambda ( hyp / err )
                            (if
                                (vl-catch-all-error-p
                                    (setq err
                                        (vl-catch-all-apply 'vla-delete (list hyp))
                                    )
                                )
                                (princ
                                    (strcat
                                        "\nUnable to delete hyperlink: " (vla-get-urldescription hyp)
                                        "\nReason: " (vl-catch-all-error-message err)
                                    )
                                )
                                (setq cnt (1+ cnt))
                            )
                        )
                    )
                )
            )
        )
    )
    (if (< 0 cnt)
        (princ (strcat "\nDeleted " (itoa cnt) " hyperlink" (if (= 1 cnt) "." "s.")))
        (princ "\nNo hyperlinks found to delete.")
    )
    (princ)
)
(vl-load-com) (princ)

[chlh_jd]

Try the following:

Code: [Select]

(defun c:delhyp nil
    (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk (vlax-map-collection (vla-get-hyperlinks obj) 'vla-delete))
        )
    )
    (princ)
)
(vl-load-com) (princ)
Or, a more verbose version with user feedback:

Code: [Select]

(defun c:delhyp ( / cnt )
    (setq cnt 0)
    (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk
                (vlax-map-collection (vla-get-hyperlinks obj)
                    (function
                        (lambda ( hyp / err )
                            (if
                                (vl-catch-all-error-p
                                    (setq err
                                        (vl-catch-all-apply 'vla-delete (list hyp))
                                    )
                                )
                                (princ
                                    (strcat
                                        "\nUnable to delete hyperlink: " (vla-get-urldescription hyp)
                                        "\nReason: " (vl-catch-all-error-message err)
                                    )
                                )
                                (setq cnt (1+ cnt))
                            )
                        )
                    )
                )
            )
        )
    )
    (if (< 0 cnt)
        (princ (strcat "\nDeleted " (itoa cnt) " hyperlink" (if (= 1 cnt) "." "s.")))
        (princ "\nNo hyperlinks found to delete.")
    )
    (princ)
)
(vl-load-com) (princ)

This also help me a lot , Thanks Lee 

I always use command method "DETACHURL" , It dit not delete the hyplinkinfo of nested block .

By the way , can this problem not be resolved by VLA method ?

[Lee Mac]

This also help me a lot , Thanks Lee 

You're welcome!

By the way , can this problem not be resolved by VLA method ?

Here is the equivalent Vanilla method (not as pretty):

Code: [Select]

(defun c:delhyp ( / b e i s )
    (if (setq s (ssget "_X" '((-3 ("PE_URL")))))
        (repeat (setq i (sslength s))
            (entmod (list (cons -1 (ssname s (setq i (1- i)))) '(-3 ("PE_URL"))))
        )
    )
    (while (setq b (tblnext "block" (null b)))
        (setq e (tblobjname "block" (cdr (assoc 2 b))))
        (while  (setq e (entnext e))
            (if (assoc -3 (entget e '("PE_URL")))
                (entmod (list (cons -1 e) '(-3 ("PE_URL"))))
            )
        )
    )
    (princ)
)

[ian50]

Cheers Lee - very much appreciated!

The code seems to work perfectly on all standard objects and nested objects but doesn't appear to pick up block instances where the hyperlink isn't associated with a particular nested object.

It appears that these types of hyperlinks have been added to some of the blocks by entering the block editor, not selecting anything then bringing up the properties palette and setting the hyperlink there. Is there a way of capturing these types also within the code?

[ronjonp]

It appears that these types of hyperlinks have been added to some of the blocks by entering the block editor, not selecting anything then bringing up the properties palette and setting the hyperlink there. Is there a way of capturing these types also within the code?

Try this modified version of Lee's code:

Code: [Select]

(defun c:delhyp (/ b bd e i s)
  (if (setq s (ssget "_X" '((-3 ("PE_URL")))))
    (repeat (setq i (sslength s))
      (entmod (list (cons -1 (ssname s (setq i (1- i)))) '(-3 ("PE_URL"))))
    )
  )
  (while (setq b (tblnext "block" (null b)))
    (setq e (tblobjname "block" (cdr (assoc 2 b))))
    ;; RJP added to account for block definition
    (if (setq bd (cdr (assoc 330 (entget e))))
      (if (assoc -3 (entget bd '("PE_URL")))
(entmod (list (cons -1 bd) '(-3 ("PE_URL"))))
      )
    )
    (while (setq e (entnext e))
      (if (assoc -3 (entget e '("PE_URL")))
(entmod (list (cons -1 e) '(-3 ("PE_URL"))))
      )
    )
  )
  (princ)
)

[Lee Mac]

You're welcome Ian; thanks for stepping in Ron 

[ronjonp]

 

[chlh_jd]

Here is the equivalent Vanilla method (not as pretty):

Code: [Select]

(defun c:delhyp ( / b e i s )
    (if (setq s (ssget "_X" '((-3 ("PE_URL")))))
        (repeat (setq i (sslength s))
            (entmod (list (cons -1 (ssname s (setq i (1- i)))) '(-3 ("PE_URL"))))
        )
    )
    (while (setq b (tblnext "block" (null b)))
        (setq e (tblobjname "block" (cdr (assoc 2 b))))
        (while  (setq e (entnext e))
            (if (assoc -3 (entget e '("PE_URL")))
                (entmod (list (cons -1 e) '(-3 ("PE_URL"))))
            )
        )
    )
    (princ)
)

Very perfect , Lee , Thank you very much !
Another questions I didn't understand :
1. In Vlisp help file , "[WARNING]  you can use entmod to modify entity which defined in the block , thus affecting all inserted blocks. In this way may create a kind of self-referential blocks, please do not do this, because it might make AutoCAD crashes." (--translate by google)
    Do you encountered such a situation?
2. How to understand this statement :
   

Code: [Select]

(entmod (list (cons -1 e) '(-3 ("PE_URL")))) Thank you !

[ian50]

That works flawlessly!

Big thank you to both Ron and Lee for all your efforts, you've made my day, this issue has been bugging me for weeks...

[Lee Mac]

Very perfect , Lee , Thank you very much!

You're most welcome chlh_jd, thank you for your compliments 

1. In Vlisp help file , "[WARNING]  you can use entmod to modify entity which defined in the block , thus affecting all inserted blocks. In this way may create a kind of self-referential blocks, please do not do this, because it might make AutoCAD crashes." (--translate by google)
    Do you encountered such a situation?

I should imagine such a self-referencing block would arise if you attempted to entmod/entmake an INSERT entity within its own block definition.

2. How to understand this statement :
   

Code: [Select]

(entmod (list (cons -1 e) '(-3 ("PE_URL"))))

A hyperlink is stored using xdata attached to an entity using the PE_URL Appication ID, for example:

Code - Auto/Visual Lisp: [Select]

1. (-3
2.     (
3.         "PE_URL"
4.         (1000 . "http://www.google.com")
5.         (1002 . "{")
6.         (1000 . "Google")
7.         (1002 . "{")
8.         (1071 . 0)
9.         (1002 . "}")
10.         (1002 . "}")
11.     )
12. )

The expression in question is removing all xdata associated with the PE_URL Application ID from the entity, which consequently removes the PE_URL entry from the entity xdata (since the Application ID no longer holds data).

When removing xdata from an entity, you only need to supply the entmod function with DXF Group -1 (i.e. the entity name) of the entity that is to be modified. This logic also applies when modifying xdata and modifying entities in general, but only with specific entity types, some of which I have listed below:

Code - Text: [Select]

1. TYPE      MODIFIED USING ONLY ENAME?
2. =====================================
3. ARC                   YES
4. ATTRIB (SINGLE)       YES
5. ATTRIB (MULTI)        NO
6. CIRCLE                YES
7. ELLIPSE               NO
8. HATCH                 NO
9. INSERT                YES
10. LINE                  YES
11. LWPOLYLINE            NO
12. MTEXT                 NO
13. POINT                 YES
14. POLYLINE              YES
15. SPLINE                NO
16. TEXT                  YES
17. XLINE                 NO

For example, you can change the colour of a LINE entity using simply:

Code: [Select]

(if (setq sel (ssget "_+.:E:S:L" '((0 . "LINE"))))
    (entmod (list (cons -1 (ssname sel 0)) '(62 . 1)))
)
Whereas, performing the same operation on, say, an MTEXT entity requires the complete DXF data list (or at least, the DXF groups required to create the MTEXT object in the first place).

[chlh_jd]

A hyperlink is stored using xdata attached to an entity using the PE_URL Appication ID, for example:

Code - Auto/Visual Lisp: [Select]

1. (-3
2.     (
3.         "PE_URL"
4.         (1000 . "http://www.google.com")
5.         (1002 . "{")
6.         (1000 . "Google")
7.         (1002 . "{")
8.         (1071 . 0)
9.         (1002 . "}")
10.         (1002 . "}")
11.     )
12. )

The expression in question is removing all xdata associated with the PE_URL Application ID from the entity, which consequently removes the PE_URL entry from the entity xdata (since the Application ID no longer holds data).

When removing xdata from an entity, you only need to supply the entmod function with DXF Group -1 (i.e. the entity name) of the entity that is to be modified. This logic also applies when modifying xdata and modifying entities in general, but only with specific entity types, some of which I have listed below:

Code - Text: [Select]

1. TYPE      MODIFIED USING ONLY ENAME?
2. =====================================
3. ARC                   YES
4. ATTRIB (SINGLE)       YES
5. ATTRIB (MULTI)        NO
6. CIRCLE                YES
7. ELLIPSE               NO
8. HATCH                 NO
9. INSERT                YES
10. LINE                  YES
11. LWPOLYLINE            NO
12. MTEXT                 NO
13. POINT                 YES
14. POLYLINE              YES
15. SPLINE                NO
16. TEXT                  YES
17. XLINE                 NO

For example, you can change the colour of a LINE entity using simply:

Code: [Select]

(if (setq sel (ssget "_+.:E:S:L" '((0 . "LINE"))))
    (entmod (list (cons -1 (ssname sel 0)) '(62 . 1)))
)
Whereas, performing the same operation on, say, an MTEXT entity requires the complete DXF data list (or at least, the DXF groups required to create the MTEXT object in the first place).

Lee , thank you very much for your wonderful commentary, so I know this usage of Entmod, thanks again .

[Lee Mac]

You're very welcome chlh_jd, I'm glad the explanation was clear