Jaap Marchal Posted December 9, 2010 Share Posted December 9, 2010 How to Replace an object (rectangle) with a named block and keep the hyperlink. Can it be done bij lisp? Jaap Quote Link to comment Share on other sites More sharing options...
Michaels Posted December 9, 2010 Share Posted December 9, 2010 it is really odd . What is the purpose of that work ? Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 10, 2010 Author Share Posted December 10, 2010 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. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted December 10, 2010 Share Posted December 10, 2010 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! Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 10, 2010 Author Share Posted December 10, 2010 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 Quote Link to comment Share on other sites More sharing options...
BlackBox Posted December 10, 2010 Share Posted December 10, 2010 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. Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 10, 2010 Author Share Posted December 10, 2010 (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) ) Quote Link to comment Share on other sites More sharing options...
BlackBox Posted December 10, 2010 Share Posted December 10, 2010 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: Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 10, 2010 Author Share Posted December 10, 2010 gives a error: ; error: Automation Error. Filer error Quote Link to comment Share on other sites More sharing options...
BlackBox Posted December 10, 2010 Share Posted December 10, 2010 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. Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 10, 2010 Author Share Posted December 10, 2010 sorry, forgot to fill in the block name..................and now...........it deleted the rectange but there is no block............. Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 10, 2010 Author Share Posted December 10, 2010 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted December 11, 2010 Share Posted December 11, 2010 (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 Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 11, 2010 Author Share Posted December 11, 2010 Wow,...works perfect. Is there a lisp to put the attached hyperlink into a attribute with te tag HYPERILNK of an selected block? Jaap Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted December 11, 2010 Share Posted December 11, 2010 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? Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 11, 2010 Author Share Posted December 11, 2010 Both please ........... Quote Link to comment Share on other sites More sharing options...
Jaap Marchal Posted December 12, 2010 Author Share Posted December 12, 2010 Thanks A separate LISP? or as part of this? Hello Lee, A serate lisp is OK Jaap Quote Link to comment Share on other sites More sharing options...
ea6weston Posted November 29, 2016 Share Posted November 29, 2016 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 Quote Link to comment Share on other sites More sharing options...
3dwannab Posted March 15, 2017 Share Posted March 15, 2017 (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) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.