BREAK INSIDE BLOCK WITH AUTOBEAK LISP

[land]

I want to use this lisp to make break inside the circles, but when using the abbs command, there are gaps, and this is because of the rotation. I want to modify the ABBS command so that it has a rotation role, because the blocks have circles.

GAP IN ABBS AUTOBREAK 1.9.dwg

[marko_ribar]

If you saved DWG prior any intervention with blocks as circles and lines going start/end to center of circles, it would be very easy to modify such lines with (polar) function to make lines shorter by radius of circles from both ends and with the same angle lines were before...

[marko_ribar]

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.

Edited February 18, 2023 by marko_ribar

[BIGAL]

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.

Edited February 19, 2023 by BIGAL

[marko_ribar]

14 hours ago, BIGAL said:

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 circel with gap you make a polygon say 20 sides then use that to make wipeout. Use draworder also to bring circle to top.

That with WIPEOUT may and may not be useful... You pollute DWG with additional entities and it just can't be precise like with my posted code...

Just don't know why I haven't gained solution, or kudo for posted routine...

[devitg]

4 hours ago, marko_ribar said:

Just don't know why I haven't gained solution, or kudo for posted routine...

Maybe because no one had test it 

[devitg]

On 2/18/2023 at 7:01 AM, land said:

I want to use this lisp to make break inside the circles, but when using the abbs command, there are gaps, and this is because of the rotation. I want to modify the ABBS command so that it has a rotation role, because the blocks have circles.

GAP IN ABBS AUTOBREAK 1.9.dwg 172.44 kB · 1 download

 

 

 

 

 

 

 

Edited February 19, 2023 by devitg
my fault

[BIGAL]

I prefer to hide as a gap then the lines are not broken but rather if another step is carried out you still get the true length and the end point co-ordinates. If its a pline ?

[devitg]

2 hours ago, BIGAL said:

I prefer to hide as a gap then the lines are not broken but rather if another step is carried out you still get the true length and the end point co-ordinates. If its a pline ?

Hi Bigal  . as I can see there is a anonymous block , I try to wblock and it only do a new *Ux block , neither I can editblock from the original dwg as Land 

Is there any way to do  reverse from anonymous to noanonymous block 

[devitg]

it is a wblock form original dwg 

circle block.dwg

[BIGAL]

I just exploded and made a new block with wipeout.

 

 

Must set wipeout frame to off.

 

 

new block.dwg

[land]

 

work very good......, thank you marko_ribar.

 

 

 

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

 

[land]

but how to restore to default values of this list

 

 

 

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

[Tharwat]

9 hours ago, devitg said:

Is there any way to do  reverse from anonymous to noanonymous block 

 

My Program Rename a block can do it for you.

https://autolispprograms.wordpress.com/rename-a-block/

[land]

On 2/18/2023 at 5:09 PM, marko_ribar said:

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.

 how to restore default sysvarpreset.

 

 

 

 

 

 

[marko_ribar]

They are restored upon routine finish, or breaks unexpectedly, or canceling by hitting ESC...