Leaderboard

Like this? (defun c:effh (/ a c d) ;; RJP » 2020-11-16 (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a)))) ) (vlax-for b (vla-get-blocks d) ;; This line will only process block definitions (if (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vlax-for o b (cond ((and (vlax-write-enabled-p o) (wcmatch (vla-get-objectname o) "AcDbHatch")) (setq c (vla-get-backgroundcolor o)) (vla-setrgb c 0 0 0) (vla-put-backgroundcolor o c) ) ) ) ) ) (foreach l a (vlax-put l 'lock -1)) (vla-regen d acallviewports) (princ) )

I can save it into a CSV file and not xlsx. I don't basically know a thing about vlx or how it's used, but as far as LISP, this is the best I can offer: (defun c:test ( / *error* fl i op org pt rtn sep x z zin) (defun *error* (msg) (if zin (setvar 'dimzin zin)) (if op (close op)) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (while (and (setq org (getpoint "\nSpecify origin <end>: ")) (setq pt (getpoint org "\nSpecify desired point <end>: ")) ) (setq rtn (cons (mapcar '- pt org) rtn)) ) (if (and (setq rtn (reverse rtn)) (setq fl (getfiled "Select output file" "" "csv" 1)) ) (progn (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")) i 0 op (open fl "w") zin (getvar 'dimzin) ) (setvar 'dimzin 8) (foreach y (cons (JH:lst->str '("Point ID" "X" "Y" "Z") sep) (mapcar '(lambda (z) (JH:lst->str (mapcar '(lambda (x) (rtos x 2 4) ) (cons (setq i (1+ i)) z) ) sep ) ) rtn ) ) (write-line y op) ) (close op) (setvar 'dimzin zin) (alert "\nCSV successfully created.") (startapp "explorer" fl) ) ) ) ;; JH:lst->str --> Jonathan Handojo ;; Concatenates a list of string into one string with a specified delimeter ;; lst - list of strings ;; del - delimiter string (defun JH:lst->str (lst del) (apply 'strcat (append (list (car lst)) (mapcar '(lambda (x) (strcat del x)) (cdr lst)))) ) Hopefully it's of some use though. Otherwise forgive me. Just trying to offer some assistance.

Thanks Jonathan for your comments. Definitely I agree with you but my codes were to help the OP to automate their work and it was not a commercial program to account for every eventuality that the user might think of or encounter, so its simple as that.

This should work unless you have the insert point of your attributed blocks far from the attribute definition. (defun c:test (/ int sel 1pt 2pt alg ent ins cls) (and (princ "\nSelect Attributed blocks to align to line : ") (setq int -1 sel (ssget "_:L" '((0 . "INSERT") (66 . 1))) ) (setq 1pt (getpoint "\nSpecify base point of line : ")) (setq 2pt (getpoint "\nSpecify next point of line : " 1pt)) (setq alg (entmakex (list '(0 . "LINE") (cons 10 1pt) (cons 11 2pt))) ) (while (setq int (1+ int) ent (ssname sel int) ) (and (setq ins (cdr (assoc 10 (entget ent))) cls (vlax-curve-getclosestpointto alg ins) ) (vlax-invoke (vlax-ename->vla-object ent) 'Move ins cls) ) ) ) (and alg (entdel alg)) (princ) ) (vl-load-com)

just to get you started. I've updated it a little bit this weekend so buttons work now. What you do with the end result (trudys-list) is your party cause it don't know didly about 'geodesism' Trudy.lsp

Good catch pkenewell , probably simpler to implement too. Done something simular in the past.... wow , 2015, has it been five years ago already... how time flies... don't even know how this program works anymore haha

Insomnia is killing me! Give this a try: ;;; Layer Filter On/Off Toggle ;;; Turn on/off layers of specified Layer Filter ;;; Required Subroutines: AT:LayerFilterList AT:ListSelect ;;; Alan J. Thompson, 09.14.09 (defun c:LFT (/ #FilterList #FilterName #Choice #Filter #LayerList) (vl-load-com) (or *Acad* (setq *Acad* (vlax-get-acad-object))) (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument *Acad*)) ) ;_ or (if (setq #FilterList (AT:LayerFilterList)) (and (setq #FilterName (car (AT:ListSelect "LayerFilter On/Off" "Select layer filter:" "10" "10" "false" (vl-sort (mapcar 'car #FilterList) '<) ) ;_ AT:ListSelect ) ;_ car ) ;_ setq (not (initget 0 "oFf oN")) (or (setq #Choice (getkword "\nTurn layers in selected Layer Filter oFf or oN [oFf oN] <oFf>: " ) ;_ getkword ) ;_ setq (setq #Choice "oFf") ) ;_ or (setq #Filter (cdr (car (vl-remove-if-not '(lambda (x) (eq #FilterName (car x))) #FilterList ) ;_ vl-remove-if-not ) ;_ car ) ;_ cdr ) ;_ setq (cond ((eq #Choice "oFf") (vlax-for x (vla-get-layers *AcadDoc*) (and (wcmatch (strcase (vla-get-name x)) (strcase #Filter)) (setq #LayerList (cons (vla-get-name x) #LayerList)) (vl-catch-all-apply 'vla-put-layeron (list x :vlax-false)) ) ;_ and ) ;_ vlax-for (print (vl-sort #LayerList '<)) (princ (strcat "\nAll " (itoa (length #LayerList)) " layers in filter \"" #FilterName "\" have been turned off!" ) ;_ strcat ) ;_ princ ) ((eq #Choice "oN") (vlax-for x (vla-get-layers *AcadDoc*) (and (wcmatch (strcase (vla-get-name x)) (strcase #Filter)) (setq #LayerList (cons (vla-get-name x) #LayerList)) (vl-catch-all-apply 'vla-put-layeron (list x :vlax-true)) ) ;_ and ) ;_ vlax-for (print (vl-sort #LayerList '<)) (princ (strcat "\nAll " (itoa (length #LayerList)) " layers in filter \"" #FilterName "\" have been turned on!" ) ;_ strcat ) ;_ princ ) ) ;_ cond ) ;_ and (princ "\nNo Layer Filters Exist in Drawing!") ) ;_ if (princ) ) ;_ defun You will need these subroutines: ;;; Get list of Layer Filters (Name & Actual Filter Codes) ;;; Return: List of dotted pairs (("Name" . "*Filter*")) ;;; Alan J. Thompson, 09.14.09 (defun AT:LayerFilterList (/ #Filters #List) (or *Acad* (setq *Acad* (vlax-get-acad-object))) (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument *Acad*)) ) ;_ or (foreach x (entget (setq #Filters (vlax-vla-object->ename (vla-item (vla-getextensiondictionary (vla-get-layers *AcadDoc* ) ;_ vla-get-layers ) ;_ vla-getextensiondictionary "ACAD_LAYERFILTERS" ) ;_ vla-item ) ;_ vlax-vla-object->ename ) ;_ setq ) ;_ entget (if (eq 3 (car x)) (setq #List (cons (cons (cdr x) (cdr (nth 10 (dictsearch #Filters (cdr x)))) ) ;_ cons #List ) ;_ cons ) ;_ setq ) ;_ if ) ;_ foreach #List ) ;_ defun and ;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