Attribute data to hyperlink of the same block

I am looking for a lisp that get data from a attribute with the tag HYPERLINK and put that data to a hyperlink. i ve already found something like it:

(defun C:ATV ( / AcaDoc AttTxt ColCnt CurEnt CurObj ExLoop LnkCol) (vl-load-com) (while (not ExLoop) (initget " ") (setq CurEnt (entsel "\nSelect Attribute : ")) (cond ((eq CurEnt "") (setq ExLoop T)) ((not CurEnt) (princ "1 selected, 0 found. ")) ((not (eq (vla-get-ObjectName (setq CurObj (vlax-ename->vla-object (car (nentselp (cadr CurEnt))))) ) "AcDbAttribute" ) ) (princ "Selected object is not an Attribute. ") ) (T (setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object)) AttTxt (vla-get-TextString CurObj) LnkCol (vla-get-Hyperlinks (vlax-ename->vla-object (car CurEnt))) ColCnt 0 ) (vla-StartUndoMark AcaDoc) (repeat (vla-get-Count LnkCol) (vla-Delete (vla-Item LnkCol ColCnt)) (setq ColCnt (1+ ColCnt)) ) (vla-Add LnkCol AttTxt) (princ (strcat "Hyperlink '" AttTxt "' added.")) (vla-EndUndoMark AcaDoc) ) ) ) (princ) )

It works fine, but i have to select a attribute and then the block has that hyperlink.

So i want a lisp that do that automatic with all blocks containning the attribute HYPERLINK.

TKS,

Jaap Marchal

Welcome to CADTutor Jaap - hope you like it here

Firstly, I would suggest you read this regarding code formatting - you can edit your original post if necessary

With regards to your task, how about something like this?

(defun c:test ( / ss ) (vl-load-com)
 ;; © Lee Mac 2010

 (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (vla-Add (vla-get-Hyperlinks obj) (vla-get-Textstring x))
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )

 (princ)
)

I notice your original code deletes existing hyperlinks - is this the desired behaviour?

Welcome to CADTutor Jaap - hope you like it here

 

Firstly, I would suggest you read this regarding code formatting - you can edit your original post if necessary

 

With regards to your task, how about something like this?

 

(defun c:test ( / ss ) (vl-load-com)
 ;; © Lee Mac 2010

 (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (vla-Add (vla-get-Hyperlinks obj) (vla-get-Textstring x))
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )

 (princ)
)

I notice your original code deletes existing hyperlinks - is this the desired behaviour?

Lee............. this is super, top. i ve been searching about a year for this .

I`am soooooooooooooooooo happy

And yes i like to delete the existing hyperlink

You're welcome Jaap

This will delete any existing hyperlinks before adding the Attribute Text as a new hyperlink:

(defun c:test ( / ss hyp ) (vl-load-com)
 ;; © Lee Mac 2010

 (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (progn
                 (vlax-for h (setq hyp (vla-get-Hyperlinks obj))
                   (vla-delete h)
                 )                    
                 (vla-Add hyp (vla-get-Textstring x))
               )
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )

 (princ)
)

You're welcome Jaap

 

This will delete any existing hyperlinks before adding the Attribute Text as a new hyperlink:

 

(defun c:test ( / ss hyp ) (vl-load-com)
 ;; © Lee Mac 2010

 (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (progn
                 (vlax-for h (setq hyp (vla-get-Hyperlinks obj))
                   (vla-delete h)
                 )                    
                 (vla-Add hyp (vla-get-Textstring x))
               )
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )

 (princ)
)

Lee..................works o so great...Tanks.............

I ve got a lisp to turn on the option: CONVERT DWG HYPERLINKS TO DWF

(defun markHlinkDWF ()

(setq mysel (ssget "_X" '((-3 ("PE_URL")))))

(setq iMaxSel (sslength mysel))

(setq iCnt 0)

(while (

(setq my_entname (ssname mysel iCnt))

(setq my_ent (entget my_entname '("PE_URL")))

;; get the entity including Xdata for hlinks

(setq my_xdata1 (assoc -3 my_ent))

;; open up the XData

(setq my_xdata_URL (nth 1 my_xdata1))

(setq my_new_xdata_URL (subst '(1071 . 1) '(1071 . 0) my_xdata_URL))

;; enable flag for convert DWG to DWF

(setq my_new_xdata1 (subst my_new_xdata_URL my_xdata_URL my_xdata1))

;; update XData

(setq my_ent (subst my_new_xdata1 my_xdata1 my_ent))

(entmod my_ent)

;; set the entity

(setq iCnt (+ iCnt 1))

)

nil

)

(defun validate ()

(setq mysel (ssget "_X" '((-3 ("PE_URL")))))

(setq iMaxSel (sslength mysel))

(setq iCnt 0)

(setq iFailCnt 0)

(while (

(setq my_entname (ssname mysel iCnt))

(setq my_ent (entget my_entname '("PE_URL")))

;; get the entity including Xdata for hlinks

(setq my_xdata1 (assoc -3 my_ent))

;; open up the XData

(setq my_xdata_URL (nth 1 my_xdata1))

(if (/= (member '(1071 . 0) my_xdata_url) nil)

(setq iFailCnt (+ iFailCnt 1))

)

(setq iCnt (+ iCnt 1))

)

(if (> iFailCnt 0)

(progn

(setq

my_str (strcat (itoa iFailCnt) " hyperlink(s) not updated.")

)

(princ my_str)

nil

)

)

)

(setq Hyplink (markHlinkdwf))

(setq Hyplinkval (validate))

Can i put this lisp into the one you provided?

Jaap

LEE

How to code for IF yes

(defun c:test ( / ss )
 (vl-load-com)
 (initget 0 "Yes No")
 (if (setq sat (getkword "\nDo You Want to Asign attribute value to another object as a hyberlink ? [Yes/No] "))
   (if (= sat "Yes")
   (progn
     )
   (progn  ;; © Lee Mac 2010
     (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (vla-Add (vla-get-Hyperlinks obj) (vla-get-Textstring x))
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )
     )))
 )

LEE

How to code for IF yes

 

(defun c:test ( / ss )
 (vl-load-com)
 (initget 0 "Yes No")
 (if (setq sat (getkword "\nDo You Want to Asign attribute value to another object as a hyberlink ? [Yes/No] "))
   (if (= sat "Yes")
   (progn
     )
   (progn  ;; © Lee Mac 2010
     (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (vla-Add (vla-get-Hyperlinks obj) (vla-get-Textstring x))
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )
     )))
 )

Sorry Lee, i am not so into lisp. I don`t see how to combine those lisps. I don`t understand de question:Do You Want to Asign attribute value to another object as a hyberlink ?

[Yes/No]

The lisp i uses to convert dwg hyperlinks to dwf. i only drag the lisp from explorer to Autocad.

Jaap

Sorry Lee, i am not so into lisp. I don`t see how to combine those lisps. I don`t understand de question:Do You Want to Asign attribute value to another object as a hyberlink ?

[Yes/No]

The lisp i uses to convert dwg hyperlinks to dwf. i only drag the lisp from explorer to Autocad.

Jaap

The one who wrote that is not Lee , but although that it's out of the thread , it's forwarded to Lee to Answer it.

Sorry Lee, i am not so into lisp. I don`t see how to combine those lisps. I don`t understand de question:Do You Want to Asign attribute value to another object as a hyberlink ?

[Yes/No]

 

 

The lisp i uses to convert dwg hyperlinks to dwf. i only drag the lisp from explorer to Autocad.

 

Jaap

Still not working. convert dwg to dwf is still not market.

Still happy with the lisps you made.

Jaap

Is this good try

(defun c:test ( / OldOS OldDM OldDP sat a at att e obj ss x)
 (vl-load-com)
 (and
   (setq OldOS (getvar "osmode"))
   (setq OldDM (getvar "dynmode"))
   (setq OldDP (getvar "dynprompt"))
   (setvar "osmode" 33)
   (setvar "dynmode" 1)
   (setvar "dynprompt" 1)
   (setvar "cmdecho" 0)
   )
 [color=red](initget 0 "Yes No")[/color]
 (if (setq sat (getkword "\nDo You Want to Asign attribute value to another object as a hyberlink ? [Yes/No] "))
   (if (= sat "Yes")
   (progn
     (and
(setq a (car (nentsel "\nSelect attribute: ")))
(setq at (entget a))
(setq att (cdr (assoc 1 at))))

     (if (setq e (car (entsel "\nSelect Object to Add Hyperlink to: ")))
(vla-Add
  (vla-get-Hyperlinks
    (vlax-ename->vla-object e)
    )
  att
  att
  )))
     (progn  ;; © Lee Mac 2010
     (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (strcase (vla-get-TagString x)) [color=red]; to be global[/color] 
 ;(eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (vla-Add (vla-get-Hyperlinks obj) (vla-get-Textstring x))
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )
     )
     ))
 (and
   (setvar "osmode" OldOS)
   (setvar "dynmode" OldDM)
   (setvar "dynprompt" OldDP)
   )
 )

Is this good try

 

(defun c:test ( / OldOS OldDM OldDP sat a at att e obj ss x)
 (vl-load-com)
 (and
   (setq OldOS (getvar "osmode"))
   (setq OldDM (getvar "dynmode"))
   (setq OldDP (getvar "dynprompt"))
   (setvar "osmode" 33)
   (setvar "dynmode" 1)
   (setvar "dynprompt" 1)
   (setvar "cmdecho" 0)
   )
 [color=red](initget 0 "Yes No")[/color]
 (if (setq sat (getkword "\nDo You Want to Asign attribute value to another object as a hyberlink ? [Yes/No] "))
   (if (= sat "Yes")
   (progn
     (and
(setq a (car (nentsel "\nSelect attribute: ")))
(setq at (entget a))
(setq att (cdr (assoc 1 at))))

     (if (setq e (car (entsel "\nSelect Object to Add Hyperlink to: ")))
(vla-Add
  (vla-get-Hyperlinks
    (vlax-ename->vla-object e)
    )
  att
  att
  )))
     (progn  ;; © Lee Mac 2010
     (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for obj
       (setq ss
         (vla-get-ActiveSelectionSet
           (vla-get-ActiveDocument (vlax-get-acad-object))
         )
       )
       (mapcar
         (function
           (lambda ( x )
             (if (strcase (vla-get-TagString x)) [color=red]; to be global[/color] 
 ;(eq "HYPERLINK" (strcase (vla-get-TagString x)))
               (vla-Add (vla-get-Hyperlinks obj) (vla-get-Textstring x))
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)
   )
 )
     )
     ))
 (and
   (setvar "osmode" OldOS)
   (setvar "dynmode" OldDM)
   (setvar "dynprompt" OldDP)
   )
 )

No no sorry,

Mybe my question was not clear enough.

The second lisp was the best so far, i only want the option (hyperlink dialog) dwg hyperlinks to dwf = marked on

I using now a lisp that i drag in the drawing and all the hyperlinks haver there option dwg hyperlinks to dwf marked on. I use the folowing lisp:

(defun markHlinkDWF ()

(setq mysel (ssget "_X" '((-3 ("PE_URL")))))

(setq iMaxSel (sslength mysel))

(setq iCnt 0)

(while (

(setq my_entname (ssname mysel iCnt))

(setq my_ent (entget my_entname '("PE_URL")))

;; get the entity including Xdata for hlinks

(setq my_xdata1 (assoc -3 my_ent))

;; open up the XData

(setq my_xdata_URL (nth 1 my_xdata1))

(setq my_new_xdata_URL (subst '(1071 . 1) '(1071 . 0) my_xdata_URL))

;; enable flag for convert DWG to DWF

(setq my_new_xdata1 (subst my_new_xdata_URL my_xdata_URL my_xdata1))

;; update XData

(setq my_ent (subst my_new_xdata1 my_xdata1 my_ent))

(entmod my_ent)

;; set the entity

(setq iCnt (+ iCnt 1))

)

nil

)

(defun validate ()

(setq mysel (ssget "_X" '((-3 ("PE_URL")))))

(setq iMaxSel (sslength mysel))

(setq iCnt 0)

(setq iFailCnt 0)

(while (

(setq my_entname (ssname mysel iCnt))

(setq my_ent (entget my_entname '("PE_URL")))

;; get the entity including Xdata for hlinks

(setq my_xdata1 (assoc -3 my_ent))

;; open up the XData

(setq my_xdata_URL (nth 1 my_xdata1))

(if (/= (member '(1071 . 0) my_xdata_url) nil)

(setq iFailCnt (+ iFailCnt 1))

)

(setq iCnt (+ iCnt 1))

)

(if (> iFailCnt 0)

(progn

(setq

my_str (strcat (itoa iFailCnt) " hyperlink(s) not updated.")

)

(princ my_str)

nil

)

Jaap

No no sorry,

...

Jaap

You may to read this thread first

Code posting guidelines

No no sorry,

Mybe my question was not clear enough.

 

The second lisp was the best so far, i only want the option (hyperlink dialog) dwg hyperlinks to dwf = marked on

 

I using now a lisp that i drag in the drawing and all the hyperlinks haver there option dwg hyperlinks to dwf marked on. I use the folowing lisp:

 

(defun markHlinkDWF ()

(setq mysel (ssget "_X" '((-3 ("PE_URL")))))

(setq iMaxSel (sslength mysel))

(setq iCnt 0)

(while (

(setq my_entname (ssname mysel iCnt))

(setq my_ent (entget my_entname '("PE_URL")))

;; get the entity including Xdata for hlinks

(setq my_xdata1 (assoc -3 my_ent))

;; open up the XData

(setq my_xdata_URL (nth 1 my_xdata1))

(setq my_new_xdata_URL (subst '(1071 . 1) '(1071 . 0) my_xdata_URL))

;; enable flag for convert DWG to DWF

(setq my_new_xdata1 (subst my_new_xdata_URL my_xdata_URL my_xdata1))

;; update XData

(setq my_ent (subst my_new_xdata1 my_xdata1 my_ent))

(entmod my_ent)

;; set the entity

(setq iCnt (+ iCnt 1))

)

nil

)

(defun validate ()

(setq mysel (ssget "_X" '((-3 ("PE_URL")))))

(setq iMaxSel (sslength mysel))

(setq iCnt 0)

(setq iFailCnt 0)

(while (

(setq my_entname (ssname mysel iCnt))

(setq my_ent (entget my_entname '("PE_URL")))

;; get the entity including Xdata for hlinks

(setq my_xdata1 (assoc -3 my_ent))

;; open up the XData

(setq my_xdata_URL (nth 1 my_xdata1))

(if (/= (member '(1071 . 0) my_xdata_url) nil)

(setq iFailCnt (+ iFailCnt 1))

)

(setq iCnt (+ iCnt 1))

)

(if (> iFailCnt 0)

(progn

(setq

my_str (strcat (itoa iFailCnt) " hyperlink(s) not updated.")

)

(princ my_str)

nil

)

 

Jaap

No no sorry,

Mybe my question was not clear enough.

The second lisp was the best so far, i only want the option (hyperlink dialog) dwg hyperlinks to dwf = marked on see image

I using now a lisp that i drag in the drawing and all the hyperlinks haver there option dwg hyperlinks to dwf marked on. I use the folowing lisp:

Jaap

Is it also posible to reverse this item? To put the hyperlink of an selected block to a tag/attribute (tag name:HYPERLINK) from that block?

Jaap

Is it possible to reverse the lisp, that the hyperlink is paste into a attribute of that block.

Jaap