Leaderboard

You can turn the viewport off and everything in it will not plot. Frozen layers will still plot, you need to turn them off.

Hi All, This is just to let you know that we have recently had a problem with the validation of new user registrations. This meant that some people will not have been able to register for the forum. This must have been frustrating and I apologise for any inconvenience this may have caused. The problem with the anti-spam controls has now been fully resolved and all visitors are now able to register. Thanks for your continued support, David

(defun c:LE-CalExtFFL ( / pt1 pt2 pt3 r TxtRotation TxtJustification radians degrees ecoA para) (setq ecoA (getvar "CMDECHO")) (setvar "CMDECHO" 0) (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object))) (command "_layer" "_m" "-LE-E-External Levels" "") (setq Prefix "") (setq Suffix "") (while (and (not para) (setq ffl-ent (car (entsel))) (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT") ) (if (setq r (vl-catch-all-apply '(lambda () ;; Get the MText object and extract text content (setq ffl-obj (entget ffl-ent)) (setq ffl-text (cdr (assoc 1 ffl-obj))) (princ (strcat "\nFFL Text found: " ffl-text)) (setq ffl-value (ExtractFFLValue ffl-text)) (princ "\nSelect points where to place the level text (Press Enter to finish): ") (if ffl-value (if (setq pt1 (getpoint "\nSelect first point: ")) (if (setq pt2 (getpoint pt1 "\nSelect second point: ")) (virtualiza) ) ) ) ) ) ) (setq para T) ) ) (if r (progn (entdel (entlast)) (princ "\r"))) (setvar "CMDECHO" ecoA) (princ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun virtualiza (/ para grd mto txJA d a1 a ejp1 ejp2 pandora color pt) (while (and (not para) (setq grd (grread nil 13 0)) (or (listp (cadr grd)) (= (car grd) 2))) (princ "\rMove the mouse to decide Justification and change Height, press < C > to change color, < + > or < - > to increase or decrease offset or press ESCAPE to cancel) ") (if (= (car grd) 2) (cond ((member (cadr grd) '(67 99)) (setq color (acad_colorDLG 1 T))) ((member (cadr grd) '(43 45)) ;|+ o -|; (vla-put-InsertionPoint (vlax-ename->vla-object mto) (vlax-3d-point (setq pt (polar (if pt pt pt1) ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) ((if (= (cadr grd) 43) + -) 0.1)))))) ) (progn (setq pt3 (cadr grd)) (setq SpotLevel (- ffl-value 0.15)) ;; Initialize point list ;; Prompt for points where to place the new MText (setq TxtRotation (angle pt1 pt2)) (setq TxtValue SpotLevel) (DefMTextJustification pt1 pt2 pt3) (if mto (if (/= TxtJustification txJA) (entmod (subst (cons 71 (setq txJA TxtJustification)) (assoc 71 (entget mto)) (entget mto))) ) (setq mto (CreateMText pt1 TxtValue TxtRotation (setq txJA TxtJustification)) a (cdr (assoc 40 (entget mto)))) ) (setq a (cdr (assoc 40 (entget mto))) ejp1 (polar pt1 ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) (/ a 2.)) ejp2 (polar pt2 ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) (/ a 2.)) ) (if (= (car grd) 3) (setq para T)) (cond ((> (setq d (distance (cadr grd) (setq ppp (inters ejp1 ejp2 (cadr grd) (polar (cadr grd) (+ (angle pt1 pt2) (/ PI 2.)) 1) nil)))) (* a (if pandora 1. 2.))) (setq d (/ d 2.) a1 (if (< (setq a1 (/ (fix (* d 10)) 10.)) 0.1) 0.1 a1) ) (entmod (append (entget mto) (if color (list (cons 40 a1) (cons 62 color)) (list (cons 40 a1))))) (setq pandora T) (princ (strcat " << Current Size: " (rtos a1 2 1) " >>")) ) (pandora (setq d (/ d 2.) a1 (if (< (setq a1 (/ (fix (* d 10)) 10.)) 0.1) 0.1 a1) ) (entmod (append (entget mto) (if color (list (cons 40 a1) (cons 62 color)) (list (cons 40 a1))))) (princ (strcat " << Current Size: " (rtos a1 2 1) " >>")) ) ) ) ) ) (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object))) ) (defun ExtractFFLValue (text-string / clean-text) (if (> (strlen text-string) 5) ;Charcters Removed from String (setq clean-text (substr text-string 6)) (setq clean-text text-string) ) (if (numberp (read clean-text)) (read clean-text) (progn (vlr-beep-reaction) (princ "\n*** ERROR : Could not extract numeric value from FFL text ***") nil ) ) ) (defun DefMTextJustification ( p1 p2 p3 / p) ;; Top Left = 1 ;; Top Center = 2 ;; Top Right = 3 ;; Middle Left = 4 ;; Middle Center = 5 ;; Middle Right = 6 ;; Bottom Left = 7 ;; Bottom Center = 8 ;; Bottom Right = 9 (setq p1 (polar p1 (angle p2 p1) 1e8)) (if (or (and (>= (angle p1 p2) 0.0) (<= (angle p1 p2) (/ PI 2.))) (>= (angle p1 p2) (/ (* 3. PI) 2.)) ) (progn (setq Prefix "+") (setq Suffix "") (if (= (asr p1 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (/ PI 2.)) 1) nil) p3) -) (setq TxtJustification 1) (setq TxtJustification 7) ) ) (progn (setq Prefix "") (setq Suffix "+") (setq TxtRotation (+ TxtRotation pi)) (if (= (asr p1 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (/ PI 2.)) 1) nil) p3) +) (setq TxtJustification 3) (setq TxtJustification 9) ) ) ) ) (defun CreateMText ( point txtvalue txtrot txtjust / txtjust txtrot mtext-obj) (setq mtext-obj (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 (getvar "CLAYER")) ; Current layer (cons 100 "AcDbMText") (cons 10 point) ; Insertion point (cons 40 0.5) ; Text height (adjust as needed) (cons 41 0.0) ; Reference rectangle width (cons 71 txtjust) (cons 72 5) ; Drawing direction (cons 1 (strcat Prefix (rtos txtvalue 2 3) Suffix)) ; Text content with "+" prefix (cons 50 txtrot) ; Rotation angle ) ) ) mtext-obj )

That isn't complete code it's just a layout of what to do. You had the getcoords function in your original post. -edit You can see this post to pull cords from an polyline without its own function https://www.cadtutor.net/forum/topic/76319-add-block-onto-polyline-vertices/#findComment-603350 (setq PTLST1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget PL1))))