Jump to content

replace an object (rectangle) with a named block and keep the hyperlink


Jaap Marchal

Recommended Posts

It`s used for dwf files to make sceens for an Building intgrated system. The Hyperlink is attached to a block. With a attribute i want it to make the hyperlink visable on paper/screen for easy checking.

It is not a web adress but something like this: root,firemap.detector.2334.43

And i work with Autocad Electrical i can put it to excel.

 

Link to comment
Share on other sites

Replacing any object (a rectangle in this case) with a named block is simple, provided you've planned what data is needed for extraction from the original object. For example, where will the named block be inserted, the centroid of the rectangle?

 

That said, where is this hyperlink stored... on the rectangle or the block?

 

If on the rectangle simply select the rectangle, calculate your insertion point, insert the named block, extract the hyperlink information, and apply it to the block (perhaps some changing visibility state is needed to make it display on the plans?).

 

Hope this helps!

Link to comment
Share on other sites

The hyperlinks are attached to the rectangles. This is the situation in the older drawings. I want convert them to blocks so i can edit them in block editor and add some attributes (TAG1, etc)for exporting to Excel. The lisp is fine but the problem is... when i select all the rectangles to convert(about 80), they get all the hyperlink from the first selected . I want to have blocks with one block name but all with there own hyperlink.

 

Jaap

Link to comment
Share on other sites

The hyperlinks are attached to the rectangles. This is the situation in the older drawings. I want convert them to blocks so i can edit them in block editor and add some attributes (TAG1, etc)for exporting to Excel. The lisp is fine but the problem is... when i select all the rectangles to convert(about 80), they get all the hyperlink from the first selected . I want to have blocks with one block name but all with there own hyperlink.

 

Post your code.

Link to comment
Share on other sites

(defun c:CTB (/ ss adoc pt_lst center blk *error* lst bpat bname bi first)
 ;;;Each primitive in a separate named block
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (setq bpat "BIS-") ;_ <- Edit block name pattern here
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (mapcar '(lambda(item)
     (setq
ss (list item)
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
)
(if (null first)
  (progn
    (setq
      bname  
     (progn
       (setq bi 0)
       (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
       bname)
      blk
     (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       bname
       )
      ) ;_ end of setq
   (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       );_ end of vla-copyobjects
    (setq first t)
  )
)
    
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
  )
  (setq
       lst     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
)
      )
     
     (mapcar 'vla-erase lst)
     ) ;_ end of and
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 )

Link to comment
Share on other sites

Merry Christmas:

 

(defun c:CTB  (/ ss mn mx insertPoint blockObj)
 (vl-load-com)
 (vla-startundomark
   (cond
     (*activeDoc*)
     ((setq *activeDoc*
             (vla-get-activedocument (vlax-get-acad-object))))))

 ;; Main code
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (progn
     (vlax-for x  (setq ss (vla-get-activeselectionset *activeDoc*))

       ;; Calculate the centroid
       (vla-getboundingbox x 'mn 'mx)
       (setq insertPoint
              (vlax-3d-point
                (mapcar '*
                        (mapcar '+
                                (vlax-safearray->list mn)
                                (vlax-safearray->list mx))
                        '(0.5 0.5 0.5))))

       ;; Insert block
       (setq blockObj
              (vla-insertblock
                (if (= "MODEL" (strcase (getvar 'ctab)))
                  (cond (*modelSpace*)
                        ((setq *modelSpace*
                                (vla-get-modelspace *activeDoc*))))
                  (cond (*paperSpace*)
                        ((setq *paperSpace*
                                (vla-get-paperspace *activeDoc*)))))
                insertPoint
                "[color=red]blockName[/color].dwg" [color=seagreen]; <- Include file path if not in support path[/color]
                1.
                1.
                1.
                0.))

       ;; Place block on original object's layer
       (vla-put-layer blockObj (vla-get-layer x))

       ;; Extract hyperlink and add to block
       (vlax-for link (vla-get-hyperlinks x)
         (vlax-invoke
           (vla-get-hyperlinks blockObj)
           'add
           (vla-get-url link)
           (vla-get-urldescription link)
           ""))

       ;; Delete original object
       (vla-delete x))

     ;; Delete selection set
     (vla-delete ss))
   (prompt "\n  <!>  Nothing Selected  <!> "))
 (vla-endundomark *activeDoc*)
 (princ))

 

 

 

- Santa's little helper :wink:

 

23.jpg

Link to comment
Share on other sites

gives a error: ; error: Automation Error. Filer error

 

That's too bad - it must be an issue between Land Desktop Companion 2009 (my software), and Electrical 2011. Works beautifully on my end.

 

Edit:

Open the code in VLIDE, and place a break at (vl-load-com), then step through hitting F8 to see exactly where it breaks. That may help you diagnose your system issue.

Link to comment
Share on other sites

it works...................the block it`s scale is bigger than the rectangle....so i didnt see it.

 

Many many thanks.

 

fijne kerstdagen en gellukig nieuwjaar (dutch for merry christmas and a happy new year)

 

Jaap

Link to comment
Share on other sites

(defun c:ctb ( / *error* _StartUndo _EndUndo doc spc ss ll ur )
 (vl-load-com)
 ;; Lee Mac 2010 - www.lee-mac.com

 (defun *error* ( msg )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (LM:ActiveSpace 'doc 'spc)

 (if (and (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16))
          (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar 'CTAB)))))
   (progn
     (_StartUndo doc)
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (vla-getBoundingBox obj 'll 'ur)
       (
         (lambda ( block )
           (mapcar
             (function
               (lambda ( p )
                 (vlax-put-property block p (vlax-get-property obj p))
               )
             )
             '(Layer Linetype Lineweight)
           )
           (
             (lambda ( hyp )
               (vlax-for h (vla-get-HyperLinks obj)
                 (vla-Add hyp (vla-get-Url h) (vla-get-UrlDescription h) (vla-get-UrlNamedLocation h))
               )
             )
             (vla-get-HyperLinks block)
           )
         )
         (vla-InsertBlock spc
           (vlax-3D-point
             (apply 'mapcar
               (cons '(lambda ( a b ) (/ (+ a b) 2.))
                 (mapcar 'vlax-safearray->list (list ll ur))
               )
             )
           )
           *dwg 1. 1. 1. 0.
         )
       )
       (vla-delete obj)
     )
     (vla-delete ss) (_EndUndo doc)
   )
 )

 (princ)
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol (other than *doc)                    ;;
;;  *spc - quoted symbol (other than *spc)                    ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (vlax-get-property
     (set *doc
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
     )
     (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
   )
 )
)

 

 

- Santa's Elf

Link to comment
Share on other sites

Wow,...works perfect. Is there a lisp to put the attached hyperlink into a attribute with te tag HYPERILNK of an selected block?

 

 

Jaap :xmas:

Link to comment
Share on other sites

Wow,...works perfect. Is there a lisp to put the attached hyperlink into a attribute with te tag HYPERILNK of an selected block?

 

Thanks

 

A separate LISP? or as part of this?

Link to comment
Share on other sites

  • 5 years later...

Hi Lee,

 

Is it possible for the block to be orientated according to the rectangle/polygon orientation and resize the same block according to the size of the rectangle/polygon to be replaced. I have attached a sample cad file - rectangle.dwg and a block file - vault.dwg.

 

Thanks

rectangles.dwg

Vault.dwg

Link to comment
Share on other sites

  • 3 months later...
(defun c:ctb ( / *error* _StartUndo _EndUndo doc spc ss ll ur )
 (vl-load-com)
 ;; Lee Mac 2010 - www.lee-mac.com

 (defun *error* ( msg )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (LM:ActiveSpace 'doc 'spc)

 (if (and (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16))
          (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar 'CTAB)))))
   (progn
     (_StartUndo doc)
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (vla-getBoundingBox obj 'll 'ur)
       (
         (lambda ( block )
           (mapcar
             (function
               (lambda ( p )
                 (vlax-put-property block p (vlax-get-property obj p))
               )
             )
             '(Layer Linetype Lineweight)
           )
           (
             (lambda ( hyp )
               (vlax-for h (vla-get-HyperLinks obj)
                 (vla-Add hyp (vla-get-Url h) (vla-get-UrlDescription h) (vla-get-UrlNamedLocation h))
               )
             )
             (vla-get-HyperLinks block)
           )
         )
         (vla-InsertBlock spc
           (vlax-3D-point
             (apply 'mapcar
               (cons '(lambda ( a b ) (/ (+ a b) 2.))
                 (mapcar 'vlax-safearray->list (list ll ur))
               )
             )
           )
           *dwg 1. 1. 1. 0.
         )
       )
       (vla-delete obj)
     )
     (vla-delete ss) (_EndUndo doc)
   )
 )

 (princ)
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol (other than *doc)                    ;;
;;  *spc - quoted symbol (other than *spc)                    ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (vlax-get-property
     (set *doc
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
     )
     (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
   )
 )
)

 

 

- Santa's Elf

 

Thanks Lee for this:

 

It was a good starting point for me to pick a block in the drawing and then use that as the replace.

 

My edit below:

(defun c:BK_Replace_With_Object ( / *error* _StartUndo _EndUndo doc spc ss ll ur )
(vl-load-com)
 ;; Lee Mac 2010 - www.lee-mac.com

 (defun *error* ( msg )
 	(if doc (_EndUndo doc))
 	(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
 		(princ (strcat "\n** Error: " msg " **")))
 	(princ)
 	)

 (defun _StartUndo ( doc ) (_EndUndo doc)
 	(vla-StartUndoMark doc)
 	)

 (defun _EndUndo ( doc )
 	(if (= 8 (logand 8 (getvar 'UNDOCTL)))
 		(vla-EndUndoMark doc)
 		)
 	)

 (LM:ActiveSpace 'doc 'spc)

 (if
 	(and

	; Old Code by LeeMac
	; (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16))

	; EDIT by 3dwannab 15-03-18
	(cond
		(
			(and
				(setq *dwg (car (entsel "\nSelect Block Entity: ")))
				(eq (cdr (assoc 0 (entget *dwg))) "INSERT")
				(setq *dwg (vla-get-effectivename (vlax-ename->vla-object *dwg)))
				)
			)
		)
		;; End EDIT

		(ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar 'CTAB))))
		)

 	(progn
 		(_StartUndo doc)

 		(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
 			(vla-getBoundingBox obj 'll 'ur)
 			(
 				(lambda ( block )
 					(mapcar
 						(function
 							(lambda ( p )
 								(vlax-put-property block p (vlax-get-property obj p))
 								)
 							)
 						'(Layer Linetype Lineweight)
 						)
 					(
 						(lambda ( hyp )
 							(vlax-for h (vla-get-HyperLinks obj)
 								(vla-Add hyp (vla-get-Url h) (vla-get-UrlDescription h) (vla-get-UrlNamedLocation h))
 								)
 							)
 						(vla-get-HyperLinks block)
 						)
 					)
 				(vla-InsertBlock spc
 					(vlax-3D-point
 						(apply 'mapcar
 							(cons '(lambda ( a b ) (/ (+ a b) 2.))
 								(mapcar 'vlax-safearray->list (list ll ur))
 								)
 							)
 						)
 					*dwg 1. 1. 1. 0.
 					)
 				)
 			(vla-delete obj)
 			)
 		(vla-delete ss) (_EndUndo doc)
 		)
 	)

 (princ)
 )

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol (other than *doc)                    ;;
;;  *spc - quoted symbol (other than *spc)                    ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
 	(vlax-get-property
 		(set *doc
 			(vla-get-ActiveDocument
 				(vlax-get-acad-object)
 				)
 			)
 		(if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
 		)
 	)
 )

(princ
(strcat
	"\n##############################################################"
	"\n_____________ Loaded 'BK_Replace_With_Object.lsp'_____________"
	"\n____________ Type 'BK_Replace_With_Object' to run_____________"
	"\n##############################################################"
	)
)
(princ)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...