Leaderboard

Here's another one I've had around for a while modified to get the transparency too. It's also good to exclude items that already contain the suffix so you don't end up with duplicate suffixes. (defun c:layersuffix (/ a el f l nl s tm) ;; RJP » 2024-05-08 (or (setq f (getenv "RJP_LayerSuffix")) (setq f (strcat "-" (getenv "username")))) (cond ((and (setq f (cond ((/= "" (setq tm (getstring (strcat "\nEnter suffix [<" f ">]: ")))) tm) (f) ) ) (setq s (ssget ":L" (list '(-4 . "<NOT") (cons 8 (strcat "*" f)) '(-4 . "NOT>")))) ) (setenv "RJP_LayerSuffix" f) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq el (entget (tblobjname "layer" (setq l (cdr (assoc 8 (entget e))))) '("AcCmTransparency")) ) (or (tblobjname "layer" (setq nl (strcat l f))) (entmakex (subst (cons 2 nl) (assoc 2 el) el)) ) (entmod (subst (cons 8 nl) (assoc 8 (entget e)) (entget e))) ) ) ) (princ) )

@pkenewell The change you proposed seems like a great code optimization. The "vl-remove-if function" is specific to removing items from a list based on a condition, which makes it a better choice for this particular case. This approach can also improve code performance in cases of large data sets, as it is more efficient than manually iterating over each list item. I just started with something to try and you make it better

@enthralled A little trickier with getting and setting transparency - but almost all can be done fairly easily with Visual LISP Activex functions. ;; New version by Pkenewell. Uses Visual LISP & ActiveX ;; Updated 5/8/2024 to check for existing layers already with new name. (defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl ss su tr) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) lyrs (vla-get-layers acdoc) ) (vla-StartUndoMark AcDoc) (if (and (setq ss (ssget ":L")) (/= (setq su (getstring T "\nEnter suffix for new layers for selected objects: ")) "") ) (progn (repeat (setq cnt (sslength ss)) (setq el (entget (ssname ss (setq cnt (1- cnt)))) la (cdr (assoc 8 el)) ) (if (not (member la llst))(setq llst (cons la llst))) ) (foreach n llst (if (not (tblsearch "LAYER" (strcat n su))) (progn (setq ob (vlax-ename->vla-object (setq el (tblobjname "LAYER" n))) col (vla-get-truecolor ob) lt (vla-get-linetype ob) lw (vla-get-lineweight ob) np (vla-get-plottable ob) nl (vla-add lyrs (strcat (vla-get-name ob) su)) tr (getpropertyvalue el "Transparency") ) (vla-put-truecolor nl col) (vla-put-linetype nl lt) (vla-put-lineweight nl lw) (vla-put-plottable nl np) (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr) ) ) ) ) ) (vla-EndUndoMark AcDoc) (princ) )

"Can this code be updated to export the text coordinates, Value and layers to excel?" YES but new code. Can send direct to excel. Last number can be found by searching text and checking its value, > oldtext newtext, so save highest value as a number. I just wonder why a point manager Hint Lee-Mac, was not used in 1st place if these are imported points. Or if they have been manually added why not use a block with POINT & 1 Attribute. Much easier to handle than plain text. Please respond about where points are coming from. Have a couple of off the shelf solutions.

I have done something similar where you select block and its tag and current value are displayed in a dcl so you edit and it makes a list of all attributes, the update of the block ignores tag names rather updates based on attribute order so actually updates all attributes. The dcl code uses my Multi getvals.lsp so that is done. As you want to do multi dwg it needs to be a 2 step process select block and do edits then save in say a file, then run across multiple dwg's reading the file for values. Going further blank out values then can set those to not update they have a value of "". This example is pushing the screen size as it has 25 attributes. You just edit the attribute values. (defun getatttagnames (obj / ) (setq lst '()) (setq atts (vlax-invoke obj 'getattributes)) (foreach att atts (setq lst (append (list (vla-get-textstring att) 29 30 (vla-get-tagstring att) ) lst) ) ) ) (defun wow ( / ss lst obj att atts str) (setq ss (ssget "x" '((0 . "INSERT")(2 . "EPCB000")))) (setq obj (vlax-ename->vla-object (ssname ss 0))) (getatttagnames obj) (setq lst (reverse lst)) (setq lst (cons "Please edit" lst)) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm lst)) (setq x -1) (foreach att atts (setq str (nth (setq x (1+ x)) ans)) (if (= str "") (princ) (vla-put-textstring att str) ) ) (princ) ) (wow) PS there is a line spacer in the dcl code so I think somewhere did a version when you have lots of rows it is left out. Line 33 in multi getvals. Multi GETVALS.lsp

For poly lines you can get angle at a point on a pline. Note Vl object. (defun alg-ang (obj pnt) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt ) ) ) )