Leaderboard

I see the viewport scale set to 1:1. My mistake, I should have clarified that I want to set the overall sheet scale to 1:1 and not change the viewports. Thanks for the info. I will work with what you have shown.

I edited something at the last minute. You may need to copy the code again

(defun c:hatcharea-GL1 (/ ss area i eo pt lst layer lstLayers color) (setq ss (ssget '((0 . "hatch"))) area 0 i 0 ) (cond ((and (and ss) (> (sslength ss) 0)) (repeat (sslength ss) (setq eo (vlax-ename->vla-object (ssname ss i))) (setq area (vlax-get eo 'Area) layer (vlax-get-property eo "LAYER") ) (if (setq lst (assoc layer lstLayers)) (setq lstLayers (subst (list layer (+ (cadr lst) area)) lst lstLayers ) ) (setq lstLayers (append lstLayers (list (list layer area)))) ) (setq i (+ i 1)) ) (if (= (setq color (vlax-get-property eo "COLOR")) 256) (setq color nil) ) (foreach layer lstLayers (if (setq pt (getpoint (strcat "\nInsertion point for area HATCHs in layer \'" (strcase (car layer)) "\'" ) ) ) (progn (setq area (cadr layer)) (setvar "CECOLOR" "BYLAYER") (command "_.STYLE" "Standard" "" 2 "" "" "" "") (command "_.text" pt 0 (strcat "Area = " (rtos area 2 2)) "" ) (command "_.STYLE" "Standard" "" 0.2 "" "" "" "") (vla-put-layer (vlax-ename->vla-object (entlast)) (car layer)) (if color (vla-put-color (vlax-ename->vla-object (entlast)) color) ) ) ) ) ) ) (princ) )

Simply: On the line before '(foreach layer lstLayers... ' write (if (= (cdr (assoc 62 (tblsearch "layer" (getvar "CLAYER")))) (setq color (vlax-get-property eo "layer")) ) (setq color " bylayer") ) And then, on the line: '(command "color" "bylayer")' replace "bylayer" with 'color'. Like That (command "color" color)

I hope you find it useful. Or anyone who needs a starting point. Running, it looks more or less like this VID-20250219-WA0001.mp4

It's fun to play with GRRead. But it's also laborious. I've been experimenting with your code this afternoon and have added a few things. But this code only supports references to endpoint objects. I didn't have enough time for more. This is the result. (defun c:santaVassolian (/ ename sumdist pt pnt ptGR polil tam dibuSnap) ;;; HERE 'LM:DisplayGrText' code .... ;;; .................................... (defun dibuSnap (pt color / xMin yMin xMax yMax) ;;; ONLY _end POINT (grvecs (list color (list (setq Xmin (- (car pt) tam)) (setq Ymin (- (cadr pt) tam)) ) (list Xmin (setq Ymax (+ (cadr pt) tam))) (list Xmin Ymax) (list (setq Xmax (+ (car pt) tam)) Ymax) (list Xmax Ymax) (list Xmax Ymin) (list Xmax Ymin) (list Xmin Ymin) ) ) T ) (princ "\nSpecify point: ") (setq ename nil sumdist 0 ) (if (setq pt (getpoint "\nSpecify Specify point: ")) (progn (princ "\nPick next point (right button for exit)...") (while (and pt (= (while (= 5 (car (setq pnt (grread nil 13 0)))) (redraw) (LM:DisplayGrText (cadr pnt) (LM:GrText (strcat (rtos (+ sumdist (distance pt (cadr pnt))) 2 2)) ) 4 ;Color 15 ;x -31 ) ;y (setq tam (* (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")) ) ) 2 ) ) (if (listp (cadr pnt)) (grvecs (list 7 pt (if (and (setq ptGR (osnap (cadr pnt) "_end")) (and (<= (abs (- (car ptGR) (car (cadr pnt)))) tam ) (<= (abs (- (cadr ptGR) (cadr (cadr pnt)))) tam ) ) (dibuSnap ptGR 1) ) ptGR (progn (setq ptGR nil) (cadr pnt) ) ) ) ) ) ) nil ) ) (redraw) (if (= (car pnt) 3) (progn (if polil (if ptGR (entmod (append (entget polil) (list (cons 10 ptGR)) ) ) (entmod (append (entget polil) (list (cons 10 (cadr pnt))) ) ) ) (if (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "0") (cons 90 2) '(70 . 128) '(62 . 256) (cons 10 pt) (if (setq ptGR (osnap (cadr pnt) "_end")) (cons 10 ptGR) (cons 10 (cadr pnt)) ) ) ) (setq polil (entlast)) ) ) ;;; (command "_.pline" pt (cadr pnt) "") ;;; (if ename ;;; (command "_.pedit" ename "_j" (entlast) "" "") ;;; ) ;;; (setq ename (entlast)) (setq sumdist (+ sumdist (distance pt (cadr pnt)))) (setq pt (if ptGR ptGR (cadr pnt) ) ) ) (setq pt nil); OBLIGA A SALIR ) ) ) ) (PRINC) )