Leaderboard

Or even a year or 2.

My WAG is they will try to post a link to some non-cad website at some point in the future.

No problem, as the point made by DIVIDE, are set to its own and unique layer , (vl-cmdf "_Layer" "M" "point1" "") (vl-cmdf "divide" ent1 n_bat) and then the ssget filter points at such layer (vl-cmdf "ZOOM" "o" ent1 "") (setq point@ent1-ss (ssget "w" p1 p2 '((0 . "point") (8 . "POINT1"))) ) ;_ end of setq So it will ssget POINTS at such layer Of course it could be do a check, if the layer do no exist.

Do you have an actual question? All you have done was to quote the previous thread.

My code was just to prove the theory about getting objects in creation order thats all. Not an answer to your question. Ok simple fix to problem convert the text to an attribute, it does not make sense to change the hard coded text in a block, that is what attributes are for. So bedit your block and repost a new dwg. The answer will come back so fast. May even add the sort by creation order.

Option 1: if this is due to color overrides in the Xref, there's a system variable XREFOVERRIDE that treats all objects as having color ByLayer. I am just finding this out! Option 2: another system variable, EXTNAME, may restrict object names to 31 characters, letters/numbers, no spaces, and a handful of special characters. If you have spaces in your layer names, they'll be truncated, so some layers could get treated as duplicates and ignored. Option 3: See this AUGI thread. Post #8 explains how VISRETAIN works. Spoiler: it's not as simple as you might think. Solution: change the offending layer name, reload, and change it back. Option 4: if the goal is to freeze a group of layers and they won't stay frozen, could you change their color to the background color? They wouldn't be frozen, but they'd effectively be invisible. Option 5: create a layer state from the viewport and restore it after the Xref reloads. Eh, may not work if I understand the Option 3 link correctly.

Rather than use the User functions I have gone to Ldata much easier and can save reals, strings etc as you use a key and a value. (vlax-ldata-get "AlanH" "Layoutname") ; "Alanh" database name "Layoutname" key name (vlax-ldata-put "AlanH" "Layoutname" ntitle) Error message (getvar "Userr1")

Thought I would start one of these. Modify them however you like. I prefix mine with AT: just to keep things organized, and it makes things easier to search through the atoms-family for loaded. They are either stuff I use, stuff I've written just to write it, or posted posted somewhere and felt it was worth hanging on to. If you like it, take it, if not, sorry. ;;; Remove Z value from point ;;; Alan J. Thompson, 3.18.09 (defun AT:FlatPoint (#Point) (list (car #Point) (cadr #Point)) ) ;;; Distance between 2 (no Z value) points ;;; Alan J. Thompson, 3.18.09 (defun AT:FlatDist (#Point1 #Point2) (distance (list (car #Point1) (cadr #Point1)) (list (car #Point2) (cadr #Point2)) ) )

LoL I just thought I'd post some randoms. No sense in them sitting in my LSP folder, only being used by me. If someone else can benefit from it, why not share it. I wrote them because I felt they were a useful addition to AutoCAD, someone out there might feel the same.

;;; Convert all values in list and sublists to positive numbers ;;; #List - list with values to convert ;;; Alan J. Thompson, 06.14.09 (defun AT:AbsList (#List) (mapcar '(lambda (x) (cond ((vl-consp x) (AT:AbsList x)) ((member (type x) (list 'INT 'REAL)) (abs x)) (T x) ) ;_ cond ) ;_ lambda #List ) ;_ mapcar ) ;_ defun

;;; Replace nth item in list ;;; #Nth - nth number in list to replace ;;; #New - replacement item ;;; #List - list to process ;;; Alan J. Thompson, 06.16.09 (defun AT:NthReplace (#Nth #New #List / #Count) (setq #Count -1) (mapcar '(lambda (x) (if (eq #Nth (setq #Count (1+ #Count))) #New x ) ;_ if ) ;_ lambda #List ) ;_ mapcar ) ;_ defun

;;; Remove nth item from list ;;; #Nth - nth number in list to remove ;;; #List - list to process ;;; Alan J. Thompson, 06.16.09 (defun AT:NthRemove (#Nth #List / #Index) (setq #Index -1) (vl-remove-if '(lambda (x) (eq #Nth (setq #Index (1+ #Index)))) #List ) ;_ vl-remove-if ) ;_ defun

Similar to vl-position, but it will return ALL, not just first. ;;; Search list for matching value, returns list of nth count locations ;;; #Value - value to search list for ;;; #List - list to search ;;; Alan J. Thompson, 06.16.09 (defun AT:ListSearch (#Value #List / #Count) (setq #Count -1) (vl-remove-if 'null (mapcar '(lambda (x) (setq #Count (1+ #Count)) (if (eq #Value x) #Count ) ;_ if ) ;_ lambda #List ) ;_ mapcar ) ;_ vl-remove-if ) ;_ defun

;;; Return List of Layers ;;; created: Alan J. Thompson 3.2.09 (defun AT:LayerList (/ search names) (while (setq search (tblnext "layer" (null search))) (setq names (cons (cdr (assoc 2 search)) names)) );while (setq names (acad_strlsort names)) );defun ;;; Layer On Routine ;;; created: Alan J. Thompson 3.2.09 (defun AT:LayerOn (layer / ent color ) (if (setq ent (entget (tblobjname "layer" layer))) (progn (setq color (assoc 62 ent)) (entmod (subst (cons 62 (abs (cdr color))) color ent)) );progn );if (princ) );defun ;; Layer Freeze Routine ;; created: Alan J. Thompson 3.2.09 (defun AT:LayerFreeze (layer / ent frz? lay0 frz?0) (if (setq ent (entget (tblobjname "LAYER" layer))) (progn (setq frz? (assoc 70 ent)) (if (= (cdr (assoc 2 ent)) (getvar "clayer") ) ;_ = (progn (setq lay0 (entget (tblobjname "LAYER" "0"))) (setq frz?0 (assoc 70 lay0)) (entmod (subst (cons 70 0) frz?0 lay0)) (setvar "clayer" "0") ) ;progn ) ;if (entmod (subst (cons 70 1) frz? ent)) ) ;progn ) ;if (princ) ) ;_ defun ;;; Layer Off Routine ;;; created: Alan J. Thompson 3.2.09 (defun AT:LayerOff (layer / ent color ) (if (setq ent (entget (tblobjname "layer" layer))) (progn (setq color (assoc 62 ent)) (entmod (subst (cons 62 (- (abs (cdr color)))) color ent)) );progn );if (princ) );defun ;;; Layer Set Routine ;;; created: Alan J. Thompson 3.2.09 (defun AT:LayerSet ( layer / ent frz? color ) (if (setq ent (entget (tblobjname "LAYER" layer))) (progn (setq frz? (assoc 70 ent)) (entmod (subst (cons 70 0) frz? ent)) (setq ent (entget (tblobjname "LAYER" layer))) (setq color (assoc 62 ent)) (entmod (subst (cons 62 (abs (cdr color))) color ent)) (setvar "clayer" layer) );progn );if (princ) );defun ;;; Create list of layer objects in drawing (excluding frozen) ;;; Alan J. Thompson, 04.16.09 (defun AT:LayerListNoFreeze (/ #Layers #List) (setq #Layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-Layers ) ;_ setq (vlax-for x #Layers (if (eq (vla-get-Freeze x) :vlax-false) (setq #List (cons x #List)) ) ;_ if ) ;_ vlax-for (vlax-release-object #Layers) #List ) ;_ defun ;;; Invert On/Off state of Vla layer object ;;; Alan J. Thompson, 04.16.09 (defun AT:LayerInvertOnOff (#LayerObj) (if (eq (vla-get-LayerOn #LayerObj) :vlax-true ) ;_ eq (vla-put-LayerOn #LayerObj :vlax-false) (vla-put-LayerOn #LayerObj :vlax-true) ) ;_ if ) ;_ defun ;;; Create list of layer objects in drawing (turned off) ;;; Alan J. Thompson, 04.28.09 (defun AT:LayerListOff (/ #Layers #List) (setq #Layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-Layers ) ;_ setq (vlax-for x #Layers (if (eq (vla-get-LayerOn x) :vlax-false) (setq #List (cons x #List)) ) ;_ if ) ;_ vlax-for (vlax-release-object #Layers) #List ) ;_ defun ;;; Create a list of layers in drawing (excluding Xrefs) ;;; #Names - If T will give list of names, nil list of ;;; vla layer objects ;;; Alan J. Thompson, 05.05.09 (defun AT:LayerListNoXref (#Names / #Layers #List) (setq #Layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-Layers ) ;_ setq (vlax-for x #Layers (if (not (wcmatch (vla-get-name x) "*|*")) (setq #List (cons (if #Names (vla-get-name x) x ) ;_ if #List ) ;_ cons ) ;_ setq ) ;_ if ) ;_ vlax-for (vlax-release-object #Layers) (if #Names (vl-sort #List '<) #List ) ;_ if ) ;_ defun ;;; Convert existing layer to VLA-Object ;;; #Layer - name of layer ;;; Alan J. Thompson, 05.07.09 (defun AT:LayerObj (#Layer / #Obj) (and (tblsearch "layer" #Layer) (setq #Obj (vla-item (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-Layers #Layer ) ;_ vla-item ) ;_ setq ) ;_ and #Obj ) ;_ defun ;;; Create list of frozen layer objects in drawing ;;; Alan J. Thompson, 06.08.09 (defun AT:LayerListFrozen (/ #Layers #List) (setq #Layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-Layers ) ;_ setq (vlax-for x #Layers (if (eq (vla-get-Freeze x) :vlax-true) (setq #List (cons x #List)) ) ;_ if ) ;_ vlax-for (vlax-release-object #Layers) #List ) ;_ defun ;;; Thaw specified layer object ;;; #LayerObj - vla layer object ;;; Alan J. Thompson, 06.08.09 (defun AT:LayerObjThaw (#LayerObj) (and (eq (type #LayerObj) 'VLA-OBJECT) (vl-catch-all-apply '(lambda () (vla-put-freeze #LayerObj :vlax-false) T) ) ;_ vl-catch-all-apply ) ;_ and ) ;_ defun ;;; List of layer objects ;;; Alan J. Thompson, 06.02.09 (defun AT:LayerObjList (/ #List) (vlax-for x (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-Layers (setq #List (cons x #List)) ) ;_ vlax-for #List ) ;_ defun ;;; Turn off specified layer object ;;; #LayerObj - vla layer object to turn off ;;; Alan J. Thompson, 06.08.09 (defun AT:LayerObjOff (#LayerObj) (and (eq (type #LayerObj) 'VLA-OBJECT) (vl-catch-all-apply '(lambda () (vla-put-layeron #LayerObj :vlax-false) T) ) ;_ vl-catch-all-apply ) ;_ and ) ;_ defun ;;; Turn on specified layer object ;;; #LayerObj - vla layer object to turn on ;;; Alan J. Thompson, 06.08.09 (defun AT:LayerObjOn (#LayerObj) (and (eq (type #LayerObj) 'VLA-OBJECT) (vl-catch-all-apply '(lambda () (vla-put-layeron #LayerObj :vlax-true) T) ) ;_ vl-catch-all-apply ) ;_ and ) ;_ defun ;;; Delete all objects on and purge specified layer ;;; #LayerName - Layername to delete and purge ;;; Alan J. Thompson, 09.19.09 (defun AT:LayerNuke (#LayerName / #Layers #Layer #SS) (setq #Layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ;_ vla-get-activedocument ) ;_ vla-get-layers ) ;_ setq (if (tblsearch "layer" #LayerName) (progn (setq #Layer (vla-item #Layers #LayerName)) (or (not (eq (getvar "clayer") #LayerName)) (progn (vla-put-freeze (vla-item #Layers "0") :vlax-false) (setvar "clayer" "0") ) ;_ progn ) ;_ or (vla-put-freeze #Layer :vlax-false) (vla-put-lock #Layer :vlax-false) (and (setq #SS (ssget "_X" (list (cons 8 #LayerName)))) (mapcar '(lambda (x) (vla-delete (vlax-ename->vla-object (cadr x)))) (ssnamex #SS) ) ;_ mapcar ) ;_ and (not (vla-delete #Layer)) ) ;_ progn ) ;_ if ) ;_ defun

;;; Edit text box (Old Mtext editor) ;;; Returns typed in textstring ;;; Alan J. Thompson, 09.18.09 (defun AT:EditTextBox (/ *error* #Cmdecho #Mtexted #Mtext #String) (setq *error* (lambda (msg) (and #Mtext (entdel #Mtext)) (and #Cmdecho (setvar "cmdecho" #Cmdecho)) (and #Mtexted (setvar "mtexted" #Mtexted)) ) ;_ lambda #Cmdecho (getvar "cmdecho") #Mtexted (getvar "mtexted") ) ;_ setq (setvar "cmdecho" 0) (vl-catch-all-apply 'setvar (list "mtexted" "OldEditor")) (setq #Mtext (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 (trans (cadr (grread t 4 4)) 1 0)) ) ;_ list ) ;_ entmakex ) ;_ setq (vl-cmdf "_.mtedit" #Mtext) (setq #String (vla-get-textstring (vlax-ename->vla-object #Mtext))) (*error* nil) (if (/= #String "") #String ) ;_ if ) ;_ defun

;;; Getstring Dialog Box ;;; #Title - Title of dialog box ;;; #Default - Default string within edit box ;;; Alan J. Thompson, 08.25.09 (defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString) (setq #FileName (vl-filename-mktemp "" "" ".dcl") #FileOpen (open #FileName "W") ) ;_ setq (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";" "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;" "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {" "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}" "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {" "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//" ) (write-line x #FileOpen) ) ;_ foreach (close #FileOpen) (setq #DclID (load_dialog #FileName)) (new_dialog "TempEditBox" #DclID) (set_tile "Title" #Title) (set_tile "Edit" #Default) (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)" ) ;_ action_tile (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog #DclID) (vl-file-delete #FileName) #NewString ) ;_ defun

;list select dialog ;create a temp DCL multi-select list dialog from provided list ;value is returned in list form, DCL file is deleted when finished ;example: (setq the_list (AT:listselect "This is my list title" "Select items to make a list" "25" "30" "true" (list "object 1" "object 2" "object 3")) ;if mytitle is longer than defined width, the width will be ignored and it will fit to title string ;if mylabel is longer than defined width, mylabel will be truncated ;myheight and mywidth must be strings, not numbers ;mymultiselect must either be "true" or "false" (true for multi, false for single) ;created by: alan thompson, 9.23.08 ;some coding borrowed from http://www.jefferypsanders.com (thanks for the DCL examples) (defun AT:ListSelect ( mytitle ;title for dialog box mylabel ;label right above list box myheight ;height of dialog box !!*MUST BE STRING*!! mywidth ;width of dialog box !!*MUST BE STRING*!! mymultiselect ;"true" for multiselect, "false" for single select mylist ;list to display in list box / retlist readlist count item savevars fn fo valuestr dcl_id ) (defun saveVars(/ readlist count item) (setq retList(list)) (setq readlist(get_tile "mylist")) (setq count 1) (while (setq item (read readlist)) (setq retlist(append retList (list (nth item myList)))) (while (and (/= " " (substr readlist count 1)) (/= "" (substr readlist count 1)) ) (setq count (1+ count)) ) (setq readlist (substr readlist count)) ) );defun (setq fn (vl-filename-mktemp "" "" ".dcl")) (setq fo (open fn "w")) (setq valuestr (strcat "value = \"" mytitle "\";")) (write-line (strcat "list_select : dialog { label = \"" mytitle "\";") fo) (write-line (strcat " : column { : row { : boxed_column { : list_box { label =\"" mylabel "\"; key = \"mylist\"; allow_accept = true; height = " myheight "; width = " mywidth "; multiple_select = " mymultiselect "; fixed_width_font = false; value = \"0\"; } } } : row { : boxed_row { : button { key = \"accept\"; label = \" Okay \"; is_default = true; } : button { key = \"cancel\"; label = \" Cancel \"; is_default = false; is_cancel = true; } } } } }") fo) (close fo) (setq dcl_id (load_dialog fn)) (new_dialog "list_select" dcl_id) (start_list "mylist" 3) (mapcar 'add_list myList) (end_list) (action_tile "cancel" "(setq ddiag 1)(done_dialog)") (action_tile "accept" "(setq ddiag 2)(saveVars)(done_dialog)") (start_dialog) (if (= ddiag 1) (setq retlist nil) ) (unload_dialog dcl_id) (vl-file-delete fn) retlist );defun

;;; Insert all Page Setups into drawing (will overwrite if exists) ;;; #DrawingFile - name of DWG file from which to import ;;; Alan J. Thompson, 07.29.09 (defun AT:PageSetups (#DrawingFile) (if (findfile #DrawingFile) (progn (command "_.psetupin" (findfile #DrawingFile) "*") (while (wcmatch (getvar "cmdnames") "*PSETUPIN*") (command "_yes") ) ;_ while T ) ;_ progn ) ;_ if ) ;_ defun