Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

using Lisp to add a hyperlink to a specific attribute

30 REPLIES 30
Reply
Message 1 of 31
vrod2000
2057 Views, 30 Replies

using Lisp to add a hyperlink to a specific attribute

I have searched the site and reviewed one program, but this doesn't seem to fit the bill for me.

 

As an old Lisp writer, I'm looking for some hints to point me in the right direction.  I haven't used hyperlinks in my programs yet, so this will be new to me.

 

The goal:

 

(I provide a text file with a list of drawings and the path to each drawing.)

 

1. Make a selection set of all attributes on drawing

2. Compare each item in the selection set to the list of drawings.

3. If an attributes matches an entry on the drawing list, then a hyperlink is to be added to the attribute, which points to the drawing (using stored path).

 

I can already do this with plain ole text, but it is getting a little complex with attributes.

 

The idea is to run a script that will turn drawing references into hyperlinks on every drawing in the construction package.

 

thanks.

30 REPLIES 30
Message 21 of 31
vrod2000
in reply to: pbejse

Sweet!

 

I'll try it out soon and let you know how it goes!

 

Right now, I'm thinking of starting my weekend early, so it might not be until Monday that I check it out.

 

thanks for the code, I'm sure I will get it to work.

 

 

Message 22 of 31
vrod2000
in reply to: pbejse

I tried it out this morning....the program works using my drawing list, however it is not deleting the existing hyperlinks.

 

Have you tested that part out?  As an example, make a small drawing list with values, then change it and rerun the program.

 

 

Message 23 of 31
pbejse
in reply to: vrod2000

Of course I did,       Smiley Happy

granting the attribute  a "clean" one or just one count of hyperlink  , tell you what

 

(defun c:givemethecount nil
(vl-load-com)
(print 
(vla-get-count
(vla-get-hyperlinks 
	(vlax-ename->vla-object (car (nentsel))))))
  (princ)
  )

 Hit the attribute with this one and tell me what it says

 

or better yet.. post the drawing in here

 

Message 24 of 31
pbejse
in reply to: pbejse

oops. Smiley Surprised

my bad

 

I think i know what happen.

Change this

 

  (strcat (cadr hpt) (car hpt) "*.dwg)

 

to

 

  (strcat (cadr hpt) (car hpt) ".dwg")

 

with the code before when you pick the attribute with givethepath thingy. i would show you a string with filename *.dwg

If by somehow you get a value more that 1 with givemethecount, i think i have an idea how to fix that

 

 

 

 

 

Message 25 of 31
vrod2000
in reply to: vrod2000

It is still not replacing the existing hyperlinks. This means if a drawing reference changes, it will still point to the prior hyperlink.    hmmmm.....

 

 

Message 26 of 31
vrod2000
in reply to: vrod2000

I ran that program.  The count is 5.  There must be some links ontop each other. 

 

It can erase all hyperlinks for the matching attribute. That would be fine with me.

Also, if the attribute has no value, the hyperlink should be erased. (that way if a reference is removed, the hyperlink will go away).

 

attached is the sample drawing.

Message 27 of 31
pbejse
in reply to: vrod2000

Got the file, tested it a dozen times for you

 

(defun c:HyperL  (/ blks dwglist str nw_lst blk hpt htp)
  (vl-load-com)
  (if (setq blks (ssget '((0 . "INSERT") (66 . 1))))
    (progn
      (setq DWGLST (open "c:/scripts/drawings/dwglst.txt" "r"))
      (while (setq str (read-line DWGLST))
        (if (not (eq str "EOF"))
          (setq nw_lst (cons (list (strcase str) (read-line DWGLST)) nw_lst))))
      (close Dwglst)
      (while (setq blk (ssname blks (setq cntr (1+ cntr))))
        (foreach
           at_str  (vlax-invoke
                     (vlax-ename->vla-object blk)
                     'GetAttributes)
          (if
            (setq hpt (assoc (strcase (vla-get-textstring at_str)) nw_lst))
             (progn
               (if (> (vla-get-count
                        (setq htp (vla-get-hyperlinks at_str)))
                      0)
                 (vlax-for cn htp
                 (vla-delete cn))) ;if Hyperlink Exist
               (vla-add
                 (vla-get-hyperlinks at_str)
                 (strcat (cadr hpt) (car hpt) ".dwg")
                 "File Hyperlink")))    ;if
          );foreach
        );while
      );progn
    );if ssget
  (princ))

 

I think  now its all good Smiley Happy

Message 28 of 31
vrod2000
in reply to: vrod2000

Smiley Very Happy

 

That did it!!!!   I just need to modify it, so it will simply make a selection set of all symbols on the drawing (no picking required).

 

This is something I'll work on in the next week. It is the least I can do.

 

Very nice so far!

Message 29 of 31
dharandesign
in reply to: vrod2000

How to add filepath in the cad drawing attribute using lisp ?

  
Can anyone help me in this?

 

Message 30 of 31
pbejse
in reply to: dharandesign

You mean the path of the current drawing?

 

(defun c:AddPrefix  (/ String)
  (vl-load-com)
  (cond (
    (and
     (setq sTring (car (nentsel "\nSelect Attribute:")))
     (eq (cdr (assoc 0 (entget String))) "ATTRIB")
     (vla-put-textstring
       (vlax-ename->vla-object String)
       (strcat
         (getvar 'Dwgprefix)
         (vla-get-textstring (vlax-ename->vla-object String)))))
     )
    )
  )

 Hope this helps

 

 You need to invoke regen

 

Message 31 of 31
dharandesign
in reply to: vrod2000

Dear Sir,

    Thank you for your help. I got the below program by the browser.

It is somewhat tough for me to  understand.But I am using that now.

 

;-============-;
;- Text  Find -;
;-    *~*     -;
;  Written by -;
; Mark Mercier ;
;   05-06-09   ;
;-============-;

; Improvements:
; Text within blocks
; Improved selection set.. maybe do away with the whole "list" thing and go straight VLA

(defun c:tfind()
  (tfindfun nil nil 0)
  )

(defun tfindfun(inputF inputR caseSn / goto goWhile strinF strinR selSet selTxt searep case count error)
  ; 01 Create selection set. GOTO 02 if success, or GOTO 08 if fail
  ; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 06. If both strings, GOTO 07. Otherwise, return error and GOTO 08
  ; 03 Display menus and obtain data from user. If Search, GOTO 04. If Replace, GOTO 05
  ; 04 Search option selected. Prompt user for single search term. GOTO 06
  ; 05 Replace option selected. Prompt user for search term and replace term. GOTO 07
  ; 06 One string has been passed. Assume automatic search. Run same as current (tfind). GOTO FINISH
  ; 07 Two strings have been passed. Assume automatic replace. Pass both strings to (replace) function. GOTO FINISH
  ; 08 FINISH. Return errors if needed. End loop and program.
  (vl-load-com)
  (setq goTo 1)
  (setq goWhile 1)
  (setq count 0)
  (if (not (mlml (list caseSn) (list 0 1))) (progn (setq goWhile nil) (princ "\nCase selection not recognized.")))
  (if (= caseSn 0) (setq case "N") (setq case "Y"))
  (while goWhile
    (cond
      ((= goTo 1)
       (setq selSet (extTxtPt (ssget "_X" (list (cons -4 "<OR") (cons 0 "TEXT,MTEXT") (cons -4 "<AND") (cons 0 "INSERT") (cons 66 1) (cons -4 "AND>") (cons -4 "OR>")))))
       (if selSet (setq goTo 2) (setq error "\nSelection set not found." goTo 8))
       )
      ((= goTo 2)
       ; Check input, pass to whatever.
       (cond
     ((and (= inputF nil) (= inputR nil))
      (setq goTo 3)
      )
     ((and (= (type inputF) 'STR) (= inputR nil))
      (setq strinF inputF)
      (setq goTo 6)
      )
     ((and (= (type inputF) 'STR) (= (type inputR) 'STR))
      (setq strinF inputF)
      (setq strinR inputR)
      (setq goTo 7)
      )
     (t
      (setq error "\nPassed arguments are not accepted.")
      (setq goTo 😎
      )
     )
       )
      ((= goTo 3)
       ; Obtain desired option from user
       (while (not (mlml (list (setq searep (strcase (getstring nil "\nSelect option [Find/Replace/Quit/Case]: "))))
                 (list "F" "FIND" "R" "REPLACE" "Q" "QUIT" "C" "CASE")
                 ))
     )
       (cond
     ((mlml (list searep) (list "F" "FIND"))
      (setq goTo 4)
      )
     ((mlml (list searep) (list "R" "REPLACE"))
      (setq goTo 5)
      )
     ((mlml (list searep) (list "Q" "QUIT"))
      (setq goTo 😎
      )
     ((mlml (list searep) (list "C" "CASE"))
      (while (not (mlml (list (setq case (strcase (getstring nil "\nCase sensitive? [Yes/No]: "))))
                    (list "Y" "YES" "N" "NO")
                    ))
        )
      )
     )
       )
      ((= goTo 4)
       ; Obtain search string from user, set to strinF
       (while (eq "" (setq strinF (getstring T "\nEnter search term: "))))
       (setq goTo 6)
       )
      ((= goTo 5)
       ; Obtain search string and replace string from user, set to strinF and strinR respectively
       (while (eq "" (setq strinF (getstring T "\nEnter find term: "))))
       (while (eq "" (setq strinR (getstring T "\nEnter replace term: "))))
       (setq goTo 7)
       )
      ((= goTo 6)
       ; Search drawing for strinF
       (cond
     ((mlml (list case) (list "Y" "YES"))
      ; Compare using (vl-string-search strinF input), view selection
      ; use "while" to get all search occurances
      (foreach selVar selSet
        (if (vl-string-search strinF (nth 0 selVar))
          (progn
        (setq count (1+ count))
        (if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))
        (command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
        (getstring "\nPress 'Enter' to continue: ")
        )
          )
        )
      )
     ((mlml (list case) (list "N" "NO"))
      ; Compare using (vl-string-search (strcase strinF) (strcase input)), view selection
      ; use "while" to get all search occurances
      (foreach selVar selSet
        (if (vl-string-search (strcase strinF) (strcase (nth 0 selVar)))
          (progn
        (setq count (1+ count))
        (if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))
        (command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
        (getstring "\nPress 'Enter' to continue: ")
        )
          )
        )
      )
     )
       (if (= count 0) (setq error "\nNo matches found.") (setq error (strcat (itoa count) " matches found.")))
       (setq goTo 😎
       )
      ((= goTo 7)
       ; Replace strinF with strinR
       (cond
     ((mlml (list case) (list "Y" "YES"))
      ; Compare using (vl-search-string strinF input), modify using (vl-string-subst) within a while loop
      (foreach selVar selSet
        (setq selTxt (nth 0 selVar))
        (setq seaLoc 0)
        (while (setq seaLoc (vl-string-search strinF selTxt seaLoc))
          (setq selTxt (vl-string-subst strinR strinF selTxt seaLoc))
          (setq seaLoc (+ seaLoc (strlen strinR)))
          (setq count (1+ count))
          )
        (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)
        )
      )
     ((mlml (list case) (list "N" "NO"))
      ; Compare using (vl-string-search (strcase strinF) (strcase input)), modify using (vl-string-subst) within a while loop
      (foreach selVar selSet
        (setq selTxt (nth 0 selVar))
        (setq seaLoc 0)
        (while (setq seaLoc (vl-string-search (strcase strinF) (strcase selTxt) seaLoc))
          (setq selTxt (strcat (substr selTxt 1 seaLoc) strinR (substr selTxt (+ 1 seaLoc (strlen strinF)))))
          (setq seaLoc (+ seaLoc (strlen strinR)))
          (setq count (1+ count))
          )
        (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)
        )
      )
     )
       (if (= count 0) (setq error "\nNo occurances found.") (setq error (strcat (itoa count) " occurances modified.")))
       (setq goTo 😎
       )
      ((= goTo 😎
       (if error (princ error))
       (setq goWhile nil)
       )
      )
    )
  (princ)
  )

(defun mlml(inSMLChar inSMLStri / returnVarMS toCheck chkWith)
  (setq returnVarMS nil)
  (if (and (= (type inSMLChar) 'LIST)
       (= (type inSMLStri) 'LIST)
       )
    (progn
      (foreach toCheck inSMLStri
    (foreach chkWith inSMLChar
      (if (eq toCheck chkWith) (setq returnVarMS T))
      )
    )
      );/progn
    )
  returnVarMS
  ); Checks a list to see if a member of that list is the same as a member of another list. Returns T or nil

(defun extTxtPt(ssList / subVar getEnt entTyp entTxt entPnt entLay entHgt grp66 entAtt getEntAtt entAttTyp uniLst)
  (setq uniLst nil)
  (setq subVar 0)
  (if ssList
  (repeat (sslength ssList)
    (setq getEnt (entget (cadr (car (ssnamex ssList subVar)))))
    (setq entTyp (cdr (assoc 0 getEnt)))
    (cond
      ((or (= entTyp "TEXT") (= entTyp "MTEXT"))
       (setq entTxt (cdr (assoc 1 getEnt)))
       (setq entPnt (cdr (assoc 10 getEnt)))
       (setq entHgt (cdr (assoc 40 getEnt)))
       (setq entLay (cdr (assoc 410 getEnt)))
       (setq entNam (cdr (assoc -1 getEnt)))

       (setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))
       )
      ((= entTyp "INSERT")
       (setq grp66 (assoc 66 getEnt))
       (if grp66
     (progn
       (setq entAtt (entnext (cdr (assoc -1 getEnt))))
           (setq getEntAtt (entget entAtt))
           (setq entAttTyp (cdr (assoc 0 getEntAtt)))
       )
     )
       (while (= entAttTyp "ATTRIB")
     (setq entTxt (cdr (assoc 1 getEntAtt)))
     (setq entPnt (cdr (assoc 10 getEntAtt)))
         (setq entHgt (cdr (assoc 40 getEntAtt)))
     (setq entLay (cdr (assoc 410 getEntAtt)))
     (setq entNam (cdr (assoc -1 getEntAtt)))
    
     (setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))

     ; Get next entity.
     (setq entAtt (entnext (cdr (assoc -1 getEntAtt))))

     ; Get ent and ent type
     (setq getEntAtt (entget entAtt))
     (setq entAttTyp (cdr (assoc 0 getEntAtt)))
     )
       )
      (t
       )
      )
    (setq subVar (1+ subVar))
    )
    )
  uniLst
  ); Return list of all text-based objects (Text, MText, Attribute) in the current drawing

 

 

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost