Leaderboard

found this one under a layer of dust : ;;; https://lispbox.wordpress.com/2016/05/01/remove-any-unloaded-unreferenced-xrefsimagespdfsdgns-and-dwfs-in-a-one-click/ ;;; Remove any unloaded (unreferenced) XREFs,IMAGE's,PDF's,DGN's and DWF's in a one click ;;; Combined from existing subroutines by Igal Averbuh 2016 ;;; Based on https://www.theswamp.org/index.php?topic=51337.0 ;;; With respect to T.Willey ; Detach any unloaded (unreferenced) XREFs (defun C:dux () (vlax-for BIND_xrefname (vla-get-blocks (vla-get-ActiveDocument (vlax-get-Acad-object))) (if (= (vla-get-isxref BIND_xrefname) ':vlax-true) (progn (setq BIND_cont (entget (vlax-vla-object->ename BIND_xrefname)) BIND_cont (tblsearch "BLOCK" (cdr (assoc 2 BIND_cont))) ) (if (or (= (cdr (assoc 70 BIND_cont)) 4) (= (cdr (assoc 70 BIND_cont)) 12)) (vla-Detach BIND_xrefname) ) ) ) ) ) (defun c:RID ( / isDefReferenced dict data name tData lst imName ) ; Remove image definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_IMAGE_DICT") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " image definition(s).")) ) ) (princ) ) (defun c:RPD ( / isDefReferenced dict data name tData lst imName ) ; Remove pdf definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_PDFDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " pdf definition(s).")) ) ) (princ) ) (defun c:RDD ( / isDefReferenced dict data name tData lst imName ) ; Remove dgn definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_DGNDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " dgn definition(s).")) ) ) (princ) ) (defun c:RWD ( / isDefReferenced dict data name tData lst imName ) ; Remove dwf definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_DWFDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " dwf definition(s).")) ) ) (princ) ) (defun c:eid () (c:dux) (c:rid) (c:rpd) (c:rdd) (c:rwd) (vl-cmdf "_.externalreferences") (princ) ) (c:eid)

pltools.lsp centerPline.LSP

Depending on your version of CAD, you can use this: (defun c:test ( ) (command "_.-insert" "yourblockname" "_s" 1 "_r" 0 "_re" "_y") (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\")) (princ) )

I think this code should meet what you need. ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:subTexta (/ e n le vlae txu tx cj g? tg) (vl-catch-all-apply '(lambda () (while (or (/= (setq tx (getstring (strcat "\nType TEXT to add to DIMENSION (escape to EXIT) " (if tx (strcat "<" tx ">") "") ": "))) "") txu) (set (if (= tx "") 'tx 'txu) (if (= tx "") txu tx)) (setq n nil cj (ssget "_:L" '((0 . "*DIMENSION")))) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq g? (/= (setq tg (vla-get-Textoverride (setq vlae (vlax-ename->vla-object e)))) "")) ;(vla-put-Textoverride vlae (if g? (strcat tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat tg "<>\\X" tx)));ACTIVA ESTA LÍNEA SI QUIERES EVITAR QUE PONGA EL SIGNO + DELANTE DEL PRIMER TEXTO Y DESACTIVA LA SIGUIENTE LÍNEA DE CODIGO (vla-put-Textoverride vlae (if g? (strcat (if (wcmatch tg "+*") "" "+") tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat "+" (rtos (vla-get-Measurement vlae) 2 (vla-get-PrimaryUnitsPrecision vlae)) "\\X" tx))) ) ) ) ) (princ) )

Here are two good options from Lee Mac

Hi, Here is another version of the rolling ball by the bisection method. Part of the code is from Lee-Mac, thank you. The code does not work for any curves and in the case presented in jpg you must first select the upper curve then the lower one (line). ; Mid of the two curves, method rolling ball ; Part of the code is from Lee-Mac (thank you) ; 2020-05-28 = Roy437 = (vl-load-com) (defun c:mc ( / *error* a b c d1 d2 dis ds ent1 ent2 eps len_ent1 p1 p2 pp sel tmp ) (setvar 'CMDECHO 0) (setvar 'OSMODE 0) (setq eps 0.0001) (command "color" 3) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (if (not (and (setq ds (getenv "LMac\\dist")) (setq ds (atof ds)) (< 0 ds) ) ) (setenv "LMac\\dist" (rtos (setq ds 1.0))) ) (if (setq sel (ssget "_:L" '( (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE") (-4 . "<NOT") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&") (70 . 88) (-4 . "AND>") (-4 . "NOT>") ) ) ) (progn (initget 4) (if (setq tmp (getreal (strcat "\nSpecify length of arc(ds) <" (rtos ds) ">: "))) (setenv "LMac\\dist" (rtos (setq ds tmp))) ) (LM:startundo (LM:acdoc)) (setq ent1 (ssname sel 0) ent2 (ssname sel 1) dis 0.0 len_ent1 (vlax-curve-getdistatparam ent1 (vlax-curve-getendparam ent1)) ) (command "pline") (while (< dis len_ent1) (if (setq p1 (vlax-curve-getpointatdist ent1 dis)) (progn (setq p2 (vlax-curve-getClosestPointTo ent2 p1) a p2 b p1 d1 0.0 d2 1.0 ) ; Bisection method ; --------------------------------------------------------------------- (while (> (abs (- d2 d1)) eps) (setq c (midp a b) pp (vlax-curve-getClosestPointTo ent1 c) d1 (distance c pp) d2 (distance c p2) ) (if (< d1 d2) (setq b c) (setq a c) ) ) ; --------------------------------------------------------------------- (command c) ) ) (setq dis (+ dis ds)) ) (command) (LM:endundo (LM:acdoc)) ) ) (princ) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Midpoint - Lee Mac ;; Returns the midpoint of two points (defun midp ( a b ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b) ) (princ "\nMC") (princ) I'm waiting for comments.

Try to use eTransmit instead. That usually always works even when I get errors such as these.