tombu Posted April 20, 2016 Share Posted April 20, 2016 I use this code change Anonymous block to normal block. ;;Anonymous block change to normal block Is there a better way to do this ? Any suggestions ? Thanks! I've seen a few routines through the years and haven't tested yours, but this is what I've used since it came out: ;=============================================== ; UnAnon.Lsp Jul 05, 1998 ;====================================== (princ "\nCopyright (C) 1998, Fabricated Designs, Inc.") (princ "\nLoading UnAnon v1.0 ") (setq uan_ nil lsp_file "UnAnon") ;================== For Automated Calling From Another Program ========= (defun uan_auto (ar1) (UnAnon ar1)) ;================== Macros ============================================= (defun PDot ()(princ ".")) (PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++ (defun uan_smd () (SetUndo) (setq olderr *error* *error* (lambda (e) (and (/= e "quit / exit abort") (princ (strcat "\nError: *** " e " *** "))) (command-s "_.UNDO" "_END" "_.U") (uan_rmd)) uan_var '( ("CMDECHO" . 0) ("MENUECHO" . 0) ("MENUCTL" . 0) ("MACROTRACE" . 0) ("OSMODE" . 0) ("SORTENTS" . 119)("MODEMACRO" . ".") ("BLIPMODE" . 0) ("EXPERT" . 0) ("SNAPMODE" . 1) ("PLINEWID" . 0.0) ("ORTHOMODE" . 1) ("GRIDMODE" . 0) ("ELEVATION" . 0) ("THICKNESS" . 0) ("FILEDIA" . 0) ("FILLMODE" . 0) ("SPLFRAME" . 0) ("UNITMODE" . 0) ("TEXTEVAL" . 0) ("ATTDIA" . 0) ("AFLAGS" . 0) ("ATTREQ" . 1) ("ATTMODE" . 1) ("UCSICON" . 1) ("HIGHLIGHT" . 1) ("REGENMODE" . 1) ("COORDS" . 2) ("DRAGMODE" . 2) ("DIMZIN" . 1) ("PDMODE" . 0) ("CECOLOR" . "BYLAYER") ("CELTYPE" . "BYLAYER"))) (foreach v uan_var (setq m_v (cons (getvar (car v)) m_v) m_n (cons (car v) m_n)) (setvar (car v) (cdr v))) (princ (strcat (getvar "PLATFORM") " Release " (substr (ver) 18 2) " - Convert To Anonymous Blocks ....\n")) (princ)) (PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++ (defun uan_rmd () (setq *error* olderr) (mapcar 'setvar m_n m_v) (command-s "_.UNDO" "_END") (prin1)) (PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++ (defun SetUndo () (and (zerop (getvar "UNDOCTL")) (command-s "_.UNDO" "_ALL")) (and (= (logand (getvar "UNDOCTL") 2) 2) (command-s "_.UNDO" "_CONTROL" "_ALL")) (and (= (logand (getvar "UNDOCTL") 8) (command-s "_.UNDO" "_END")) (command-s "_.UNDO" "_GROUP")) (PDot);++++++++++++ Get Entity Name ++++++++++++++++++++++++++++++++++++ (defun GetOne (/ st os) (setq os (getvar "SNAPMODE") s nil) (setvar "SNAPMODE" 0) (while (not st) (setq st (ssget))) (while (> (sslength st) 1) (setq st nil) (princ "\nOnly 1 At A Time Please\n") (while (not st) (setq st (ssget)))) (setvar "SNAPMODE" os) (setq s (ssname st 0))) (PDot);++++++++++++ Convert An Anonymous Block To Named Block ++++++++++ (defun UnAnon (b / tdef en ed bc bn bd in) ;Supply ename (setq bn "TEMP1" bc 1) (while (tblsearch "BLOCK" bn) (setq bc (1+ bc) bn (strcat "TEMP" (itoa bc)))) (and (= (type b) 'ENAME) (setq bd (entget b) in (cdr (assoc 2 bd)))) (if (or (not bd) (not in) (/= "INSERT" (cdr (assoc 0 bd))) (/= "*U" (substr in 1 2)) (= (logand (cdr (assoc 70 (tblsearch "BLOCK" in))) 4) 4) (= (logand (cdr (assoc 70 (tblsearch "BLOCK" in))) 16) 16) (= (logand (cdr (assoc 70 (tblsearch "BLOCK" in))) 32) 32)) (progn (princ "*** Not An Anonomymous Block *** ") (setq bn nil bc nil bd nil in nil b nil) (exit))) (setq tdef (tblsearch "BLOCK" in) en (cdr (assoc -2 tdef)) ed (entget en)) (entmake (list (cons 0 "BLOCK") (cons 2 bn) (cons 70 0) (cons 10 (cdr (assoc 10 tdef))))) (entmake ed) (while (setq en (entnext en)) (setq ed (entget en)) (entmake ed)) (entmake (list (cons 0 "ENDBLK"))) (setq bd (subst (cons 2 bn) (assoc 2 bd) bd)) (entmod bd) (entupd b) (princ (strcat "\n" bn))) (PDot);************ Main Program *************************************** (defun uan_ (/ m_v m_n olderr uan_var s) (uan_smd) (GetOne) (UnAnon s) (uan_rmd)) (defun c:UnAnonall (/ ss i) (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 67 (if (= (getvar "TILEMODE") 1) 0 1))))) (and ss (setq i (sslength ss)) (while (not (minusp (setq i (1- i)))) (setq en (ssname ss i)) (if (= "*U" (substr (cdr (assoc 2 (entget en))) 1 2)) (UnAnon en)))) (prin1)) (PDot);************ Load Program *************************************** (defun C:UnAnon () (uan_)) (if uan_ (princ "\nUnAnon Loaded\n")) (prin1) ;================== End Program ======================================== Until it stops working for me I'll keep it. Quote Link to comment Share on other sites More sharing options...
David Bethel Posted April 20, 2016 Share Posted April 20, 2016 Until it stops working for me I'll keep it. LOL I feel older and older every time I see some of my old routines. And I thought I was fairly experienced when I wrote it . HaHA ! Glad it still works. -David Quote Link to comment Share on other sites More sharing options...
tombu Posted April 20, 2016 Share Posted April 20, 2016 LOL I feel older and older every time I see some of my old routines. And I thought I was fairly experienced when I wrote it . HaHA ! Glad it still works. -David Thank You, I've used it many times through the years! We use AutoTurn which inserts everything as Anonymous blocks. Never knew the actual author's name, couldn't remember if I downloaded it or got in in an email from the guilds. Should I replace "Fabricated Designs, Inc." with "David Bethel"? I try to include download links when available, have you done any updates? Quote Link to comment Share on other sites More sharing options...
David Bethel Posted April 20, 2016 Share Posted April 20, 2016 Should I replace "Fabricated Designs, Inc." with "David Bethel"? I try to include download links when available, have you done any updates? No need, I own Fabricated Designs, Inc. I'd have to look into any updates. The copy on my machine is from 2010, but based on 2002 routine. Probably not much changed as it has never not worked for me as well. Thanks! -David Quote Link to comment Share on other sites More sharing options...
iconeo Posted April 21, 2016 Share Posted April 21, 2016 Thank You, I've used it many times through the years! We use AutoTurn which inserts everything as Anonymous blocks. Never knew the actual author's name, couldn't remember if I downloaded it or got in in an email from the guilds. Should I replace "Fabricated Designs, Inc." with "David Bethel"? I try to include download links when available, have you done any updates? It been several years since I've used AutoTurn but I could've sworn there was an option to assign actual names to the blocks... I sorta miss jackknifing those semis. Offtopic, but are there any free alternatives to autoturn out there? Quote Link to comment Share on other sites More sharing options...
SLW210 Posted April 21, 2016 Share Posted April 21, 2016 See CADTOOLS, it has a pretty good turn simulation. Quote Link to comment Share on other sites More sharing options...
tombu Posted April 21, 2016 Share Posted April 21, 2016 See CADTOOLS, it has a pretty good turn simulation. Nice! I've looked at a few including http://hawsedc.com/gnu/turn.php and AutoTrack by Savoy now owned by AutoDesk and renamed as Vehicle Tracking. Stuck with what the County has always used, but I will download and check out CADTOOLS. Thanks, Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted April 21, 2016 Share Posted April 21, 2016 I use those regularly for Anonymous - Non-anonymous blocks... HTH, M.R. (defun c:blk2anonym ( / adoc blks ss bl bln ) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (setq blks (vla-get-blocks adoc)) (vla-startundomark adoc) (command "_.-xref" "u" "*") (prompt "\nPick block to rename it to anonymous") (while (not (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT")))))) (setq bl (ssname ss 0)) (setq bln (if (vlax-property-available-p (vlax-ename->vla-object bl) 'effectivename) (vla-get-effectivename (vlax-ename->vla-object bl)) (vla-get-name (vlax-ename->vla-object bl)) ) ) (command "_.undo" "") (vla-put-name (vla-item blks bln) "*U") (princ) ) (defun c:noname_blk (/ holdecho holdblip a aa blkref) (vl-load-com) (command "_.undo" "_group") (setq holdecho (getvar "cmdecho")) (setq holdblip (getvar "blipmode")) (setvar "cmdecho" 0) (setvar "blipmode" 0) (prompt "\nSelect object to establish anonymous block: ") (setq aa (ssget)) (prompt "\nPick Insertion point ") (setq a (rtos (* (getvar "cdate") 1e8))) (if (/= aa nil) (progn (command "_.block" a "\\" aa "") (command "_.insert" a "@" "" "" "") (setq blkref (vlax-ename->vla-object (entlast))) (vla-put-name (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-name blkref) ) "*u" ) (vlax-release-object blkref) ) (alert "\nNot select any object!") ) (setvar "blipmode" holdblip) (setvar "cmdecho" holdecho) (command "_.undo" "_end") (princ) ) ;;change Annonymous block to normal block ;;Tested in R2005 ;;By LUCAS (defun c:an_2_n ( / ss n ) (setq n "") (while (not (snvalid n)) (setq n (getstring t "\nSpecify new block name: ")) ) (prompt "\nSelect Annonymous block: ") (if (setq ss (ssget "_+.:S:E:L" '((0 . "INSERT") (2 . "`**,AUDIT*,A$*")))) (progn (vla-put-name (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-name (vlax-ename->vla-object (ssname ss 0))) ) n ) (vla-auditinfo (vla-get-activedocument (vlax-get-acad-object)) :vlax-true ) (vla-put-name (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-name (vlax-ename->vla-object (ssname ss 0))) ) n ) ) (alert "\nNot match Annonymous block! Empty sel.set - please try again!...") ) (princ) ) ;; Objects to Block - Lee Mac ;; Converts a selection of objects to a block reference. (defun c:obj2blk ( / e i l n p s x ) (if (and (setq s (ssget "_:L" '((-4 . "<NOT") (0 . "ATTDEF,VIEWPORT") (-4 . "NOT>")))) (progn (while (not (or (= "" (setq n (getstring t "\nSpecify Block Name <Anonymous>: "))) (and (snvalid n) (null (tblsearch "BLOCK" n)) ) ) ) (princ "\nBlock name invalid or already exists.") ) (if (= "" n) (setq n "*U") ) (setq p (getpoint "\nSpecify Base Point: ")) ) ) (progn (entmake (list '(0 . "BLOCK") (cons 10 (trans p 1 0)) (cons 02 n) (cons 70 (if (wcmatch n "`**") 1 0)) ) ) (repeat (setq i (sslength s)) (entmake (entget (setq e (ssname s (setq i (1- i)))))) (if (= 1 (cdr (assoc 66 (entget e)))) (progn (setq x (entnext e) l (entget x) ) (while (/= "SEQEND" (cdr (assoc 0 l))) (entmake l) (setq x (entnext x) l (entget x) ) ) (entmake l) ) ) (entdel e) ) (if (setq n (entmake '((0 . "ENDBLK")))) (entmake (list '(0 . "INSERT") (cons 02 n) (cons 10 (trans p 1 0)) ) ) ) ) ) (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.