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

How to Replace an object (rectangle) with a named block and keep the hyperlink.

Can it be done bij lisp?

Jaap

it is really odd .

What is the purpose of that work ?

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!

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

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.

(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)
 )

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:

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

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.

sorry, forgot to fill in the block name..................and now...........it deleted the rectange but there is no block.............

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

(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

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

Jaap

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?

Both please ...........

Thanks

 

A separate LISP? or as part of this?

Hello Lee,

A serate lisp is OK

Jaap

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

(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)