Search the Community
Showing results for tags 'programming help'.
-
Need Help with Lisp Routine for Setting Layer Properties
CADChaser posted a topic in AutoLISP, Visual LISP & DCL
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) ) Standard layer Properties.xls- 31 replies
-
- 1
-
- layerproperty
- standardlayer
-
(and 1 more)
Tagged with: