Hyperlink in block attribute (as a field)

[chulse]

Does anyone know a way to set a hyperlink in a block (either in an attrib with a field or xdata) via lisp? I have a current code that inserts blocks and populates attributes (Thanks Lee Mac, Alanjt and others here), but would like to have an attribute contain a field with a hyperlink.

Any pointers in the right direction would be appreciated.

 

Thanks

Edited November 10, 2010 by chulse

[chulse]

I found this in HELP for vba, but I don't know how to do this with lisp. This wouldn't use a field, but that would be fine for my application too.

 

Any help much appreciated.

 

A URL and URL description.

VBA class name:

AcadHyperlink

Create using:

Hyperlinks.Add

Access via:

Hyperlinks.Item

 

 

URL and URL descriptions are stored within the XData of their corresponding object. The Hyperlink objects themselves are not stored with the drawing. This means that every time you request the Hyperlink object for an object, a new Hyperlink object is created and the URL and URL description for that hyperlink is read out of the XData. Because of this, you should be careful to avoid creating multiple Hyperlink objects to reference the same URL information. Updating one of these Hyperlink objects would not update the second object.

To create a hyperlink use the Add method. To edit or query a hyperlink, use the following methods and properties:

Methods Delete

 

Properties

Application

URL URLDescription URLNamedLocation

[Sweety]

Insert your Hyperlink in a text and put it beside the block , and use the following codes by Lee to insert the text into your block.

 

;;----------------=={ Add Objects to Block }==----------------;;
;;                                                            ;;
;;  Adds all objects in the provided SelectionSet to the      ;;
;;  definition of the specified block.                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, June 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - Entity name of reference insert                   ;;
;;  ss    - SelectionSet of objects to add to definition      ;;
;;------------------------------------------------------------;;

(defun LM:AddObjectstoBlock ( block ss / ObjLst org doc vector )
 ;; © Lee Mac 2010
 (vl-load-com)

 (setq ObjLst (LM:ss->vla ss) org (vlax-3D-point '(0. 0. 0.)))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 
 (setq vector
   (vlax-3D-point
     (mapcar '- (cdr (assoc 10 (entget block)))
       (cdr
         (assoc 10
           (entget
             (tblobjname "BLOCK"
               (cdr (assoc 2 (entget block)))
             )
           )
         )
       )
     )
   )
 )

 (mapcar '(lambda ( obj ) (vla-move obj vector org)) ObjLst)

 (vla-CopyObjects (vla-get-ActiveDocument (vlax-get-acad-object))
   (LM:ObjectVariant ObjLst)
   (vla-item (vla-get-Blocks doc)
     (LM:GetBlockName (vlax-ename->vla-object block))
   )
 )

 (LM:ApplyFootoSS (lambda ( x ) (entdel x)) ss)

 (vla-regen doc acAllViewports)
)

;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, June 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;
                        
(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype
       (cons 0 (1- (length data)))
     )
     data
   )    
 )
)

;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, June 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;

(defun LM:ObjectVariant ( lst )
 ;; © Lee Mac 2010
 (LM:SafearrayVariant vlax-vbobject lst)
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, June 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)

;;-------------------=={ Get Block Name }==-------------------;;
;;                                                            ;;
;;  Retrieves the Block Name as per the Block Definition      ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, June 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  obj - VLA Block Reference Object                          ;;
;;------------------------------------------------------------;;
;;  Returns:  Block Name [sTR]                                ;;
;;------------------------------------------------------------;;

(defun LM:GetBlockName ( obj )
 (vlax-get-property obj
   (if (vlax-property-available-p obj 'EffectiveName)
     'EffectiveName 'Name
   )
 )
)

;;------------------=={ Apply Foo to SS }==-------------------;;
;;                                                            ;;
;;  Applies a function to every entity in a SelectionSet      ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, June 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - a function taking one argument (an entity name)     ;;
;;  ss  - valid SelectionSet (pickset)                        ;;
;;------------------------------------------------------------;;
;;  Returns:  Last evaluation of function foo                 ;;
;;------------------------------------------------------------;;

(defun LM:ApplyFootoSS ( foo ss )
 ;; © Lee Mac 2010
 (
   (lambda ( i / e )
     (while (setq e (ssname ss (setq i (1+ i)))) (foo e))
   )
   -1
 )
)
;; Test Function.

(defun c:add2Blk ( / ss ent )

 (if (and (setq ss  (ssget "_:L"))
          (setq ent (car (entsel "\nSelect Block: ")))
          (eq "INSERT" (cdr (assoc 0 (entget ent)))))

   (LM:AddObjectstoBlock ent ss)

 )
 (princ)
)

[Sittingbull]

 

 

Hi everyone.

I'm looking for a Lisp somewhat similar to this.

It involves Hyperlinks as well.

Al tho i i don't wish the hyperlink to be put in an attribute or txt of my block.

It's kind of the opposite.

Would anyone be so kind to help me out with this?

I'm trying with bit and pieces of other lisp routines, but i really suck at it.

 

 

Here is what I'm looking for:

 

• run lisp
• lisp checks for all the blocks in the drawing containing TEA_ in the block's name.
• if such a block is found, check if the block has an attribute called ATT1 (TAG will be edited later)
• if attribute is found, extract and save whatever has been written in the attribute ATT1
• finally, add a hyperlink on the block containing the following text: "https://www.this_is_my_link.com/this_is_the_text_of_ATT1" (the first part of the link is constant)
• repeat for all blocks in drawing
• end lisp

 

The purpose is the following.

I have loads of plans containing TFT screens all over the place.

I print PDF's of those plans and would like to open the datasheet of the screen when i click on it in my pdf.

The link needs to be on the block itself(In it's properties if you will). Not in an attribute or text of the block.

I'm adding a dwg file with a block.

Any help would be appreciated.

 

 

Greetings,

Michael

 

 

 

TFT.dwg

[BIGAL]

Here is a start

(setq ss (ssget "X" (list (cons 0 "Insert")(cons 2 "TEA*"))))
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS (setq x (-x 1)) )) 'getattributes)
(if (= "ATT1"  (strcase (vla-get-tagstring att)))
(progn
(setq newstr (vla-get-textstring att))
; do your hyperlink
)
)
)

I did something similar used the phone number of staff and added their photo by saving each staff picture as phonenum.jpg, had a lisp matched photo to seat position via phone number. It also had a grid index over it, added staff in alphabetical order and grid Alan H J 1 as well as their phone extension.

[Sittingbull]

 

Thx Bilal. It is something to start with i guess.

I fired up my AutoLisp ABC document i downloaded years ago.

I wasn't expecting VLA-stuff, but something more basic.

Like reading the att content, merge it with link, use the -hyperlink command?

 

I've found this lisp of Lee Mac.

It uses the content of an attribute to make a circle.

Could you help me tweek it for my needs?

 

Quote

(defun c:attcircle ( / a b e i n o s )
    (setq b "TreeTest" ;; Block Name
          n "V_DBH_DIM" ;; Tag Name
          b (strcase b)
    )
    (if (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," b)))))
        (repeat (setq i (sslength s))
            (and (setq e (ssname s (setq i (1- i))))
                 (= b (strcase (LM:blockname (setq o (vlax-ename->vla-object e)))))
                 (setq a (LM:vl-getattributevalue o n))
                 (setq a (distof a 3))
                 (entmake (list '(0 . "CIRCLE") (assoc 10 (entget e)) (cons 40 (* 6.0 a))))
            )
        )
    )
    (princ)
)

 

[BIGAL]

TEA* block name.

ATT1 tag name of attribute.

Newstr value of matching attribute returned

your hyperlink string (strcat newstr "hyperlink")

;do your hyperlink is (vla-put-textstring att "your hyperlink string")

 

Not sure how to make any simpler.

Edited February 7, 2020 by BIGAL

[Roy_043]

Perhaps @Sittingbull wants to change the hyperlinks property of the insert, not the textstring of the attribute?

Edited February 7, 2020 by Roy_043

[Roy_043]

Maybe this:

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Conv_Collection_To_List (coll / ret)
  (reverse
    (vlax-for a coll
      (setq ret (cons a ret))
    )
  )
)

(defun c:Att_To_Link ( / doc linkPrefix lnks nme ss str tag)
  (setq nme "TEA_DISP_001")                            ; Change this. Block name in CAPS.
  (setq tag "ATT1")                                    ; Change this. Attribute tag in CAPS.
  (setq linkPrefix "https://www.this_is_my_link.com/") ; Change this.

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`**," nme)))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (if
        (and
          (= nme (strcase (vla-get-effectivename obj)))
          (setq str
            (vl-some
              '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
              (vlax-invoke obj 'getattributes)
            )
          )
          (/= "" str)
        )
        (progn
          (setq lnks (vla-get-hyperlinks obj))
          (mapcar 'vla-delete (KGA_Conv_Collection_To_List lnks))
          (vla-add lnks (strcat linkPrefix str) (strcat linkPrefix str)) ; 2nd argument is the description.
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

[Sittingbull]

 

 

Only the lonelisp... damdamdadididouha... ohyeyeyeyeah...

 

You nailed it Roy.

Thx a lot man.

 

Greetings to everyone,

Michael

 

[Sittingbull]

 

 

Hello everyone.

 

I was wandering if any of you could improve this nice little lisp.

For now it needs the exact name of the block in order to work.

Would it be possible to add a wildcard in there?

 

Instead of the whole name, just a part.

f.e.: 

(setq nme "TEA_DISP_001")                            ; Change this. Block name in CAPS.

would become:

(setq nme "TEA_*")                            ; Change this. Block name in CAPS.

or any part of the name replaceable with the asterisk...

 

 

Thanks a bunch.

Greetings,

SB

 

 

 

 

 

[ronjonp]

Quick look and change:

;; this
(= nme (strcase (vla-get-effectivename obj)))
;; to this
(wcmatch (strcase (vla-get-effectivename obj)) (strcase nme))

 

[Sittingbull]

 

Hi ron,

 

It works like a charm.

Thanks a lot for this.

 

 

Greetings,

SB

[ronjonp]

Glad to help!