Hello people
The .lsp attached replaces a polyline with a specific block,
This works perfectly well.
There is the possibility of in addition to replacing them write the attributes based on the closest text.
(defun c:BK_Replace ( / *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:")))
(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 "\nLoaded 'BK_Replace' "))
(princ)
Example dwg
Good times BeeKeeCZ.