Leaderboard

Just get a copy of Steal.lsp from www.Lee-mac.com does more than layers, can be command line driven so no user interaction, use (if (not steal)(load "StealV1-8)) to demand load the program a simple 1 line in your code.

Another way if the block is always a circle why not just add a wipeout to the block. Then every time is automatic gap, in BEDIT can save as new name if required, so can have circle or circle with gap you make a polygon say 20 sides then use that to make wipeout. Use draworder also to bring circle to top.

Here you are : (defun c:lins2blks-ins ( / *error* tttt wcs initvalueslst ucsf ti ch ss si sl r fuzz i pl speplst en ex speneplst spepall pts ) (defun *error* ( m ) (if wcs (if ucsf (while (not (and (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6) (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6) (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6) ) ) (exe (list "_.UCS" "_P")) ) ) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (exe (list "_.UNDO" "_E"))) (if doc (vla-endundomark doc) ) ) ) (if initvalueslst (mapcar (function apply_cadr->car) initvalueslst) ) (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa)) (setq fun nil) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;; (defun vl-load nil (or cad (if vlax-get-acad-object (setq cad (vlax-get-acad-object)) (progn (vl-load-com) (setq cad (vlax-get-acad-object)) ) ) ) (or doc (setq doc (vla-get-activedocument cad))) (or alo (setq alo (vla-get-activelayout doc))) (or spc (setq spc (vla-get-block alo))) ) ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;; (or (and cad doc alo spc) (vl-load)) (defun exe ( tokenslist ) ( (lambda ( tokenslist / ctch ) (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t))) (progn (cmderr tokenslist) (catch_cont ctch) ) (progn (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) t ) ) ) tokenslist ) ) (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;; (if command-s (if flag (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))) flag ctch ) (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))) ctch ) ) (if flag (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist)))) flag ctch ) (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist))) ctch ) ) ) ) (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;; (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist))) ) (defun catch_cont ( ctch / gr ) (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...") (while (and (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0))))) (setq gr (grread)) (/= (car gr) 3) (not (equal gr (list 2 13))) ) ) (if (vl-catch-all-error-p ctch) ctch ) ) (defun apply_cadr->car ( sysvarvaluepair / ctch ) (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair)) (if (vl-catch-all-error-p ctch) (progn (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair)))) (catch_cont ctch) ) ) ) (defun ftoa ( n / m a s b ) (if (numberp n) (progn (setq m (fix ((if (< n 0) - +) n 1e-8))) (setq a (abs (- n m))) (setq m (itoa m)) (setq s "") (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0)))) (setq s (strcat s (itoa b))) (setq a (- (* a 10.0) b)) ) (if (= (type n) (quote int)) m (if (= s "") m (if (and (= m "0") (< n 0)) (strcat "-" m "." s) (strcat m "." s) ) ) ) ) ) ) (setq sysvarpreset (list (list (quote cmdecho) 0) (list (quote 3dosmode) 0) (list (quote osmode) 0) (list (quote unitmode) 0) (list (quote cmddia) 0) (list (quote ucsvp) 0) (list (quote ucsortho) 0) (list (quote projmode) 0) (list (quote orbitautotarget) 0) (list (quote insunits) 0) (list (quote hpseparate) 0) (list (quote hpgaptol) 0) (list (quote halogap) 0) (list (quote edgemode) 0) (list (quote pickdrag) 0) (list (quote qtextmode) 0) (list (quote dragsnap) 0) (list (quote angdir) 0) (list (quote aunits) 0) (list (quote limcheck) 0) (list (quote gridmode) 0) (list (quote nomutt) 0) (list (quote apbox) 0) (list (quote attdia) 0) (list (quote blipmode) 0) (list (quote copymode) 0) (list (quote circlerad) 0.0) (list (quote filletrad) 0.0) (list (quote filedia) 1) (list (quote autosnap) 1) (list (quote objectisolationmode) 1) (list (quote highlight) 1) (list (quote lispinit) 1) (list (quote layerpmode) 1) (list (quote fillmode) 1) (list (quote dragmodeinterrupt) 1) (list (quote dispsilh) 1) (list (quote fielddisplay) 1) (list (quote deletetool) 1) (list (quote delobj) 1) (list (quote dblclkedit) 1) (list (quote attreq) 1) (list (quote explmode) 1) (list (quote frameselection) 1) (list (quote ltgapselection) 1) (list (quote pickfirst) 1) (list (quote plinegen) 1) (list (quote plinetype) 1) (list (quote peditaccept) 1) (list (quote solidcheck) 1) (list (quote visretain) 1) (list (quote regenmode) 1) (list (quote celtscale) 1.0) (list (quote ltscale) 1.0) (list (quote osnapcoord) 2) (list (quote grips) 2) (list (quote dragmode) 2) (list (quote lunits) 2) (list (quote pickstyle) 3) (list (quote navvcubedisplay) 3) (list (quote pickauto) 3) (list (quote draworderctl) 3) (list (quote expert) 5) (list (quote auprec) 6) (list (quote luprec) 6) (list (quote pickbox) 6) (list (quote aperture) 6) (list (quote osoptions) 7) (list (quote dimzin) 8) (list (quote pdmode) 35) (list (quote pdsize) -1.5) (list (quote celweight) -1) (list (quote cecolor) "BYLAYER") (list (quote celtype) "ByLayer") (list (quote clayer) "0") ) ) (setq sysvarlst (mapcar (function car) sysvarpreset)) (setq sysvarvals (mapcar (function cadr) sysvarpreset)) (setq sysvarvals (vl-remove nil (mapcar (function (lambda ( x ) (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals)) )) sysvarlst ) ) ) (setq sysvarlst (vl-remove-if-not (function (lambda ( x ) (getvar x) )) sysvarlst ) ) (setq initvalueslst (apply (function mapcar) (cons (function list) (list sysvarlst (mapcar (function getvar) sysvarlst) ) ) ) ) (apply (function mapcar) (cons (function setvar) (list sysvarlst sysvarvals ) ) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (exe (list "_.UNDO" "_E"))) (if doc (vla-endundomark doc) ) ) ) (if (not (exe (list "_.UNDO" "_M"))) (if doc (vla-startundomark doc) ) ) (if wcs (if (= 0 (getvar (quote worlducs))) (progn (setq ucsf (list (getvar (quote ucsxdir)) (getvar (quote ucsydir)) (trans (list 0.0 0.0 1.0) 1 0 t) ) ) (exe (list "_.UCS" "_W")) ) ) ) wcs ) (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;; (initget 1 "Yes No") (setq ch (getkword "\nDo you want to trim lines after their extensions without gaps [Yes / No] : ")) (initget 6) (setq r (cond ( (getdist "\nPick or specify radius of circles making blocks <0.75> it is needed for lines distances fuzz value : ") ) ( 0.75 ) )) (setq fuzz (* r (/ 4.0 3.0))) (prompt "\nSelect lines and blocks to extend lines to blocks centers on unlocked Layer(s)...") (if (setq ss (ssget "_:L" (list (cons 0 "LINE,INSERT")))) (progn (setq ti (car (_vl-times))) (sssetfirst nil ss) (setq si (ssget "_I" (list (cons 0 "INSERT")))) (sssetfirst nil ss) (setq sl (ssget "_I" (list (cons 0 "LINE")))) (sssetfirst) (repeat (setq i (sslength si)) (setq pl (cons (cdr (assoc 10 (entget (ssname si (setq i (1- i)))))) pl)) ) (repeat (setq i (sslength sl)) (setq speplst (cons (list (cdr (assoc 10 (setq ex (entget (setq en (ssname sl (setq i (1- i)))))))) (cdr (assoc 11 ex))) speplst)) (setq speneplst (cons (list (caar speplst) en (cadar speplst)) speneplst)) ) (setq spepall (apply (function append) speplst)) (foreach p pl (setq spepall (vl-sort spepall (function (lambda ( a b ) (< (distance a p) (distance b p)))))) (setq pts (vl-remove-if-not (function (lambda ( pp ) (< (distance pp p) fuzz))) spepall)) (foreach spenep speneplst (if (vl-some (function (lambda ( x ) (equal x (car spenep) 1e-6))) pts) (entupd (cdr (assoc -1 (entmod (subst (cons 10 p) (assoc 10 (setq ex (entget (cadr spenep)))) ex))))) ) (if (vl-some (function (lambda ( x ) (equal x (caddr spenep) 1e-6))) pts) (entupd (cdr (assoc -1 (entmod (subst (cons 11 p) (assoc 11 (setq ex (entget (cadr spenep)))) ex))))) ) ) ) (if (= ch "Yes") (repeat (setq i (sslength sl)) (setq en (ssname sl (setq i (1- i)))) (setq ex (entget en)) (setq ex (subst (cons 10 (polar (cdr (assoc 10 ex)) (angle (cdr (assoc 10 ex)) (cdr (assoc 11 ex))) r)) (assoc 10 ex) ex)) (setq ex (subst (cons 11 (polar (cdr (assoc 11 ex)) (angle (cdr (assoc 11 ex)) (cdr (assoc 10 ex))) r)) (assoc 11 ex) ex)) (entupd (cdr (assoc -1 (entmod ex)))) ) ) (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...") (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...") ) ) (*error* nil) ) HTH. M.R.

Hi Marko , the problem becomes because at the polygons.dwg . layer is freeze I noticed it while testing the OP lsp