Leaderboard

Hi everyone, I'm trying to make a Lisp routine to standardize layer properties in my drawings. I'm not very experienced with Lisp programming (though I've used AI to help), I've included my current code below. I'd be very grateful for any advice or suggestions you could offer. Thank you so much for your time! Here’s what I’m trying to do: The routine should go through all the layers in the drawing and match them to the layer standards based on layer names. If a layer name is similar to a standard name (e.g., E-EOP and !!EOP or anything with *EOP*), the routine should apply the standard properties (color, linetype, lineweight, etc.) to all similar layers. It should also dynamically load missing linetypes (if they aren’t already in the drawing) and log any missing linetypes at the end of the process. Importantly, the routine should only modify the properties of existing layers and not rename or delete anything. All Layer properties are listed in the code below, also attached Spreadsheet. attached image shows illustration of how before and after tool should works. (defun c:SetLayerProperties (/ *error* layer-name standards log-missing missing-linetypes linetype-map layer-props layer-name-matches apply-standards) ;; Error handler (defun *error* (msg) (if msg (princ (strcat "\nError: " msg))) (if (and missing-linetypes (/= (length missing-linetypes) 0)) (progn (princ "\n\nMissing Linetypes:") (mapcar '(lambda (x) (princ (strcat "\n- " x))) missing-linetypes) ) ) (princ "\nRoutine ended.") (princ) ) ;; Layer standards: (LayerName Color Linetype LineWeight Scale) (setq standards '( ("E-CENTERLINES" 253 "CENTER2" acLineWeight050 1.00) ("E-BUILDING" 253 "Continuous" acLineWeight050 1.00) ("E-CURB" 253 "Continuous" acLineWeight050 1.00) ("E-DITCH" 253 "DITCHLINE" acLineWeight018 0.75) ("E-DRAINAGE PIPE" 253 "Continuous" acLineWeight030 1.00) ("E-DRIVE WAY" 253 "Continuous" acLineWeight050 1.00) ("E-ELECTRIC" 253 "UNDER_ELEC" acLineWeight018 0.75) ("E-ELECTRIC STRUCTURE" 253 "UNDER_ELEC" acLineWeight050 1.00) ("E-EOP" 253 "Continuous" acLineWeight020 1.00) ("E-FENCE" 253 "Fence1" acLineWeight018 0.75) ("E-FIBER-OH" 253 "Overhead" acLineWeight018 0.75) ("E-FIBER-UG" 253 "UNDER_FIBER" acLineWeight018 0.75) ("E-GAS" 253 "UNDER_GAS" acLineWeight018 0.75) ("E-GUARDRAILS" 253 "GUARD_RAIL" acLineWeight002 0.20) ("E-GUTTER" 253 "Continuous" acLineWeight050 1.00) ("E-PARKING LOT" 250 "Continuous" acLineWeight050 1.00) ("E-PAVEMENT MARKINGS" 253 "Continuous" acLineWeight009 1.00) ("E-ROAD SIGN" 253 "Continuous" acLineWeight050 1.00) ("E-ROW" 8 "RIGHTOFWAY" acLineWeight035 0.70) ("E-ROW Lot line" 253 "PROPERTYLINE" acLineWeight030 0.70) ("E-ROW VDOT" 2 "RIGHTOFWAY" acLineWeight070 0.70) ("E-SANITARY-SEWER" 253 "UNDER_SAN" acLineWeight018 0.75) ("E-SIDEWALK" 253 "Continuous" acLineWeight050 1.00) ("E-STORM-SEWER" 253 "UNDER_STORMDRAIN" acLineWeight018 0.75) ("E-TACTILE PAVING" 253 "Continuous" acLineWeight050 1.00) ("E-TELEPHONE" 253 "UNDER_TELE" acLineWeight018 0.75) ("E-TELEPHONE GUY WIRE" 253 "Continuous" acLineWeight018 0.75) ("E-TRANS TRACKS" 253 "TRACKS" acLineWeight050 1.00) ("E-TREELINE" 253 "Continuous" acLineWeight050 1.00) ("E-UTILTY POLE" 250 "Continuous" acLineWeight050 1.00) ("E-WATER" 253 "UNDER_WATER" acLineWeight018 0.75) ("EX CONC DITCHES" 253 "EX. CONC. DITCH_LINE" acLineWeight018 0.75) ("LEGEND" 7 "Continuous" acLineWeight050 1.00) ("P-CONDUIT AERIAL" 10 "DASHED" acLineWeight007 0.20) ("P-CONDUIT UG" 10 "Continuous" acLineWeight070 1.00) ) ) ;; Initialize variables (setq missing-linetypes '()) (setq linetype-map (mapcar '(lambda (x) (list (car x) (nth 2 x))) standards)) ;; Load required linetypes, log missing (mapcar '(lambda (lt) (if (not (tblsearch "LTYPE" lt)) (progn (if (not (vl-catch-all-error-p (vl-catch-all-apply 'command (list "._linetype" "load" lt "")))) (princ (strcat "\nLoaded linetype: " lt)) (if (not (member lt missing-linetypes)) (setq missing-linetypes (cons lt missing-linetypes)))))) ) (mapcar 'caddr standards) ) ;; Apply standards to layers (vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq layer-name (vla-get-name layer)) (setq layer-props (car (vl-remove-if-not '(lambda (x) (wcmatch layer-name (car x))) standards))) (if layer-props (progn (vla-put-color layer (nth 1 layer-props)) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-linetype (list layer (nth 2 layer-props))))) (vla-put-linetype layer "Continuous") ) (vla-put-lineweight layer (nth 3 layer-props)) ) ) ) ;; Report missing linetypes (if missing-linetypes (progn (princ "\n\nMissing Linetypes:") (mapcar '(lambda (lt) (princ (strcat "\n- " lt))) missing-linetypes) ) ) (princ "\n\nRoutine completed successfully.") (princ) )

Here is the little modification that was missing: you already have the functionality But you should simplify the code a bit. One test you could do is to obtain the triangles using minimum circles to compare the differences. Do your tests (defun SX:M3DFACEF3DPL (/ enameOne enameSecond old_layer layerNameBase dataOne ptOne ptlistOne dataSecond ptSecond ptlistSecond len i j pt1 pt2 pt3 ind1 ind2 decideTRI ang_sub_ref ) (defun decideTRI (/ a b c d pt1Lst1 pt2Lst1 pt1Lst2 pt2Lst2 selecTRIbase->Lista1 selecTRIbase->Lista2 TRI_transgresor? ) (defun selecTRIbase->Lista1 () (setq pt1 pt1Lst1 pt2 pt2Lst1 pt3 pt1Lst2 ind1 (+ ind1 1) ) ) (defun selecTRIbase->Lista2 () (setq pt1 pt1Lst2 pt2 pt2Lst2 pt3 pt1Lst1 ind2 (+ ind2 1) ) ) (defun TRI_transgresor? (pt2 pt3 / lst1 lst2 n m pto1 pto2 lista para val ind pt2D) (defun pt2D (pt3D) (list (car pt3D) (cadr pt3D)) ) (setq pt2 (polar (pt2D pt2) (angle pt2 pt3) 0.01) pt3 (polar (pt2D pt3) (angle pt3 pt2) 0.01) lst1 (foreach ind '(-2 -1 0 1 2) (if (and (not (minusp (+ ind1 ind))) (setq val (nth (+ ind1 ind) ptlistOne)) ) (setq lst1 (append lst1 (list (pt2D val)))) ) ) lst2 (foreach ind '(-2 -1 0 1 2) (if (and (not (minusp (+ ind2 ind))) (setq val (nth (+ ind2 ind) ptlistSecond)) ) (setq lst2 (append lst2 (list (pt2D val)))) ) ) ) (setq m 0) (while (and (not para) (setq lista (nth m (list lst1 lst2)))) (setq n 0) (while (and (not para) (setq pto2 (nth (+ n 1) lista))) (setq pto1 (nth n lista)) (if (inters pt2 pt3 pto1 pto2) (setq para T) ) (setq n (+ n 1)) ) (setq m (+ m 1)) ) para ) (setq pt1Lst1 (nth ind1 ptlistOne) pt2Lst1 (nth (1+ ind1) ptlistOne) pt1Lst2 (nth ind2 ptlistSecond) pt2Lst2 (nth (1+ ind2) ptlistSecond) ) (if (and pt1Lst1 pt2Lst1 pt1Lst2 pt2Lst2) (if (= (min (setq a (abs (- (abs (ang_sub_ref (nth ind1 ptlistOne) (nth (1+ ind1) ptlistOne) (nth ind2 ptlistSecond) ) ) (/ pi 2.0) ) ) ) (setq b (abs (- (abs (ang_sub_ref (nth ind2 ptlistSecond) (nth (1+ ind2) ptlistSecond) (nth ind1 ptlistOne) ) ) (/ pi 2.0) ) ) ) ) a ) (if (not (TRI_transgresor? pt2Lst1 pt1Lst2)) (selecTRIbase->Lista1) (selecTRIbase->Lista2) ) (if (not (TRI_transgresor? pt2Lst2 pt1Lst1)) (selecTRIbase->Lista2) (selecTRIbase->Lista1) ) ) (setq lst (list pt1Lst1 pt2Lst1 pt1Lst2 pt2Lst2) lst (vl-remove nil lst) ind1 (+ ind1 10) ind2 (+ ind2 10) pt1 (nth 0 lst) pt2 (nth 1 lst) pt3 (nth 2 lst) ) ) ) (defun ang_sub_ref (pta ptb pt1 / ang_result ang_ref ang ang_desde_ptb) (setq ang_ref (angle pta ptb) ang_desde_ptb (angle ptb pt1) ) (cond ((< (abs (setq ang (- ang_ref ang_desde_ptb))) PI) ang ) ((and (> (abs (setq ang (- ang_ref ang_desde_ptb))) PI) (<= ang_ref PI) ) (+ ang_ref (- (* 2 PI) ang_desde_ptb)) ) ((and (> (abs (setq ang (- ang_ref ang_desde_ptb))) PI) (> ang_ref PI) ) (- (- ang_ref (* 2 PI)) ang_desde_ptb) ) (T (princ "\n***Caso no esperado en ang_sub_ref") ) ) ) ;;; (command-s "_UNDO" "BE") (setq enameOne (car (entsel "\nSelect the first 3DPOLYLINE:")) enameSecond (car (entsel "\nSelect the second 3DPOLYLINE:")) ) (while (or (= enameOne nil) (not (= "POLYLINE" (cdr (assoc 0 (entget enameOne))))) ) (if (= enameOne nil) (progn (prompt "\nNothing was selected. Try again...") (setq enameOne (car (entsel "\nSelect the first 3DPOLYLINE:"))) (princ) ) (progn (prompt "\nSelected entity must be 3DPOLYLINE. Try again..." ) (setq enameOne (car (entsel "\nSelect the first 3DPOLYLINE:"))) (princ) ) ) ) (while (or (= enameSecond nil) (not (= "POLYLINE" (cdr (assoc 0 (entget enameSecond))))) ) (if (= enameSecond nil) (progn (prompt "\nNothing was selected. Try again...") (setq enameSecond (car (entsel "\nSelect the second 3DPOLYLINE:")) ) (princ) ) (progn (prompt "\nSelected entity must be 3DPOLYLINE. Try again..." ) (setq enameSecond (car (entsel "\nSelect the second 3DPOLYLINE:")) ) (princ) ) ) ) (setq old_layer (getvar 'clayer) layerNameBase (cdr (assoc 8 (entget enameOne))) ) (setvar 'clayer layerNameBase) ;;; (setq objOne (vlax-ename->vla-object enameOne) ;;; objSecond (vlax-ename->vla-object enameOne) ;;; ) (setq dataOne (entget enameOne)) (while (/= (cdr (assoc 0 dataOne)) "SEQEND") (setq ptOne (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dataOne) ) ) (if (/= (nth 0 (nth 0 ptOne)) 0.0) (setq ptlistOne (cons ptOne ptlistOne)) ) (setq dataOne (entget (entnext (cdr (assoc -1 dataOne))))) ) (setq ptlistOne (mapcar 'car ptlistOne)) ; lista de puntos de la primera polil铆nea 3D (setq dataSecond (entget enameSecond)) (while (/= (cdr (assoc 0 dataSecond)) "SEQEND") (setq ptSecond (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dataSecond ) ) ) (if (/= (nth 0 (nth 0 ptSecond)) 0.0) (setq ptlistSecond (cons ptSecond ptlistSecond)) ) (setq dataSecond (entget (entnext (cdr (assoc -1 dataSecond))))) ) (setq ptlistSecond (mapcar 'car ptlistSecond)) ; lista de puntos de la segunda polil铆nea 3D (setq ptlistOne (reverse ptlistOne)) (setq ptlistSecond (reverse ptlistSecond)) ;;; (if (> (length ptlistOne) (length ptlistSecond)) ;;; (progn ;;; (setq len (length ptlistOne) ;;; i 0 ;;; j 0 ;;; ) ;;; ) ;;; (progn ;;; (setq len (length ptlistSecond) ;;; i 0 ;;; j 0 ;;; ) ;;; ) ;;; ) ;;; (while (< i len) ;;; (if (/= (nth (1+ i) ptlistOne) nil) ;;; (entmake (list (cons 0 "3DFACE") ;;; (cons 10 (nth i ptlistOne)) ;;; (cons 11 (nth j ptlistSecond)) ;;; (cons 12 (nth (1+ i) ptlistSecond)) ;;; (cons 13 (nth i ptlistOne)) ;;; ) ;;; ) ;;; ) ;;; (if (and (/= (nth (1+ i) ptlistOne) nil) ;;; (/= (nth (1+ j) ptlistSecond) nil) ;;; ) ;;; (entmake (list (cons 0 "3DFACE") ;;; (cons 10 (nth (1+ i) ptlistOne)) ;;; (cons 11 (nth (1+ j) ptlistSecond)) ;;; (cons 12 (nth i ptlistOne)) ;;; (cons 13 (nth (1+ i) ptlistOne)) ;;; ) ;;; ) ;;; ) ;;; (setq i (1+ i) ;;; j (1+ j) ;;; ) ;;; ) (setq ind1 0 ind2 0 ) (while (and (nth ind1 ptlistOne) (nth ind2 ptlistSecond) (or (nth (1+ ind1) ptlistOne) (nth (1+ ind2) ptlistSecond)) ) (decideTRI) (entmake (list (cons 0 "3DFACE") (cons 10 pt1) (cons 11 pt2) (cons 12 pt3) (cons 13 pt1) ) ) ;;; (getstring "\nPulsa INTRO") ) (setvar 'clayer old_layer) ;;; (command-s "_UNDO" "E") (princ) )

Hi, Written a tool for replacing (updating) blocks. Had some spare time untill my boss recently used the W-word again (work , yak!) Anywayz , its a prototype so I'm not sure its stable and safe yet because I only did some lab testing. I hope it will be usefull. Not sure if I will be able to work on it further any time soon because I still have a few ideas and wishes. gr. Rlx RlxBlk manual.doc RlxBlk.lsp RlxBlk.dcl

if layer's are locked maybe not. and looks like 6 pomoc 01 is also frozen in your example so that's also might be why your lisp isn't working. I try to avoid using command in lisp when you can. idk if ZWCAD can use visual lisp (defun C:dellayers76_only6 (dellay "6") (princ)) (defun dellay (str / doc lst lay del) (vl-load-com) (setq check (getvar "CLAYER")) (while (or (wcmatch check (strcat str " *")) (wcmatch check (strcat str "_*"))) (princ "\nSwitch Current layer") (exit) ) (vla-startundomark (setq Drawing (vla-get-activedocument (vlax-get-acad-object)))) ;set an undo point (setq lst (vla-get-Layers Drawing)) (setq del '()) (vlax-for layer lst (let ((lay (vla-get-Name layer))) (if (or (wcmatch lay (strcat str " *")) (wcmatch lay (strcat str "_*"))) (progn (if (= (vla-get-Lock layer) :vlax-true) (progn (if (= (ACET-UI-MESSAGE (strcat "Do you want to Delete Locked Layer " lay " (Y/N): ") "Locked Layer" (+ Acet:YESNO Acet:ICONWARNING)) 6) (progn (vla-put-Lock layer :vlax-false) ; Unlock the layer (vla-delete layer) ; Then delete (setq del (cons lay del)) ; Add layer name to the del list ) ) ) (vla-delete layer) ;Delete layer (setq del (cons lay del)) ;Add layer name to del list ) ) ) ) ) (vla-endundomark Drawing) (if (eq (setq x (length del) 0)) (princ (strcat "\nNo Layers Found Starting with """ str " *"" or """ str "_*""")) (progn (princ (strcat "\n" x " Layers(s) Deleted")) (princ del) ) ) (princ) )

Hello, esteemed colleagues, I am currently navigating the complexities of Visual LISP programming within AutoCAD with the aim to enhance my project's efficiency and customization. My endeavor involves crafting a generic code capable of altering existing layer properties. The focal point of this initiative is to enable the adjustment of layer attributes such as color (specifically to True Color format, e.g., 150,10,90), line thickness (setting it to 0.30), line type (changing it to 'continuous'), toggling print locking, and activating the layer. Despite my efforts, I am encountering a roadblock in applying True Color, leading to errors and halting progress. I am reaching out for your wisdom and guidance to rectify this issue or to approach this task more effectively. Below is the code snippet I've been grappling with. (defun c:ModCapa (/ capa colorR colorG colorB lineweight linetype plot activar) (vl-load-com) ;; Ejemplo de cómo llamar este comando: ;; (ModCapa "JY1" 125 20 50 0.25 "Continuous" "No" "Si") ;; Asignar valores directamente desde los argumentos (setq capa "NombreCapa") ; Reemplaza "NombreCapa" con el nombre real de la capa a modificar (setq colorR 125) ; Valor rojo del color (setq colorG 20) ; Valor verde del color (setq colorB 50) ; Valor azul del color (setq lineweight 0.25) ; Ancho de línea en milímetros (setq linetype "Continuous") ; Tipo de línea (setq plot "No") ; Si la capa debe ser ploteada (setq activar "Si") ; Si la capa debe ser establecida como activa ;; Verificar si la capa existe (if (not (tblsearch "LAYER" capa)) (princ (strcat "\nLa capa " capa " no existe.")) (progn ;; Modificar la capa (command "-LAYER" "M" capa "") (command "C" (strcat "C" (itoa colorR) "," (itoa colorG) "," (itoa colorB)) "") (command "L" linetype "") (if (= (strcase plot) "NO") (command "P" "No") (command "P" "Yes")) (command "W" lineweight "") (command "") ;; Establecer como capa activa si se solicita (if (= (strcase activar) "SI") (command "-LAYER" "S" capa "") ) (princ (strcat "\nLa capa " capa " ha sido modificada y activada.")) ) ) (princ) )