Leaderboard

Try changing this line : (setq gap (getvar "dimtxt")) To this line : (setq gap (* 2.0 (getvar "dimtxt")))

@BHenry85 Give this version a try. I had to add another check that the hyperlink count was greater than 0. (defun c:dext (/ a b blk cells lst myxl row x) (vl-load-com) ;; Pre-purge file ;(command "-purge" "all" "*" "no" "") ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;defun ;; Set Excel cell text (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) ;defun ;; Get Nested Values (vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-for blk a (if (and (= "AcDbBlockReference" (vla-get-objectname blk)) (= -1 (vlax-get blk 'hasattributes)) (setq a (lm:vl-getattributevalue blk "DETAIL_NUMBER")) (setq b (lm:vl-getattributevalue blk "SHEET_NUMBER")) (setq c (vlax-get-property blk 'hyperlinks)) (or (and (setq c (vlax-get-property blk 'hyperlinks)) (> (vla-get-count c) 0) (setq c (vla-get-url (vla-item c 0))) ) (setq c "NO HYPERLINK") ) ) (or (member (setq x (strcat "`" a "-" b "," c)) lst) (setq lst (cons x lst))) ) ) ) (if lst (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "Excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) (setq row 0) (foreach itm (vl-sort lst '<) (xlsetcelltext (setq row (1+ row)) 1 itm)) ) (print "NO VALUES FOUND...") ) (princ) ) ;defun

Your code basically works. I don't have Office installed on this PC, so I can't give you a proven solution with Excel. But I can suggest an alternative using the 'Standard' list that appears in your code. I've modified it, replacing the values for 'LineWeight###' with the ones I've seen from my smartphone that appear in the Excel table. And that's all you need to do to make your code work. Also, you can add more layers to the list or modify the existing ones. One more thing: there are layers in the table that don't appear in the drawing. If you want me to create them in that case, you should add some more code. (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) ;;; ) ;;; ) (setq standards '( ("E-CENTERLINES" 253 "CENTER2" 0 1.00) ("E-BUILDING" 253 "Continuous" 0 1.00) ("E-CURB" 253 "Continuous" 0 1.00) ("E-DITCH" 253 "DITCHLINE" 0 0.75) ("E-DRAINAGE PIPE" 253 "Continuous" 0.30 1.00) ("E-DRIVE WAY" 253 "Continuous" 0 1.00) ("E-ELECTRIC" 253 "UNDER_ELEC" 0 0.75) ("E-ELECTRIC STRUCTURE" 253 "UNDER_ELEC" 0 1.00) ("E-EOP" 253 "Continuous" 0.20 1.00) ("E-FENCE" 253 "Fence1" 0 0.75) ("E-FIBER-OH" 253 "Overhead" 0 0.75) ("E-FIBER-UG" 253 "UNDER_FIBER" 0 0.75) ("E-GAS" 253 "UNDER_GAS" 0 0.75) ("E-GUARDRAILS" 253 "GUARD_RAIL" 0 0.20) ("E-GUTTER" 253 "Continuous" 0 1.00) ("E-PARKING LOT" 250 "Continuous" 0 1.00) ("E-PAVEMENT MARKINGS" 253 "Continuous" 0.09 1.00) ("E-ROAD SIGN" 253 "Continuous" 0 1.00) ("E-ROW" 8 "RIGHTOFWAY" 0.35 0.70) ("E-ROW Lot line" 253 "PROPERTYLINE" 0.30 0.70) ("E-ROW VDOT" 2 "RIGHTOFWAY" 0.70 0.70) ("E-SANITARY-SEWER" 253 "UNDER_SAN" 0 0.75) ("E-SIDEWALK" 253 "Continuous" 0 1.00) ("E-STORM-SEWER" 253 "UNDER_STORMDRAIN" 0 0.75) ("E-TACTILE PAVING" 253 "Continuous" 0 1.00) ("E-TELEPHONE" 253 "UNDER_TELE" 0 0.75) ("E-TELEPHONE GUY WIRE" 253 "Continuous" 0 0.75) ("E-TRANS TRACKS" 253 "TRACKS" 0 1.00) ("E-TREELINE" 253 "Continuous" 0 1.00) ("E-UTILTY POLE" 250 "Continuous" 0 1.00) ("E-WATER" 253 "UNDER_WATER" 0 0.75) ("EX CONC DITCHES" 253 "EX. CONC. DITCH_LINE" 0 0.75) ("LEGEND" 7 "Continuous" 0 1.00) ("P-CONDUIT AERIAL" 10 "DASHED" 0.70 0.20) ("P-CONDUIT UG" 10 "Continuous" 0.70 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) )

I am on holidays back tomorrow will have a look at it