Leaderboard

With that same code that you found loaded: (defun c:dtype ( / rown tab tags vtab) (setq tags '("Door" "Number")) ; <--- Replace with the tags you want shown (c:CountAttributeValues) (setq tab (entlast) vtab (vlax-ename->vla-object tab) ) (repeat (- (setq rown (cdr (assoc 91 (entget tab)))) 2) (if (null (vl-position (vla-GetText vtab (setq rown (1- rown)) 0) tags)) (vla-DeleteRows vtab rown 1) ) ) )

Here's another .. no fancy reporting: (defun c:foo (/ _s2l pts s) (defun _s2l (s) (if s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) ) (foreach x (_s2l (setq s (ssget '((0 . "insert,lwpolyline"))))) (if (= "LWPOLYLINE" (cdr (assoc 0 (entget x)))) (progn (setq pts (mapcar 'cdr (vl-remove-if '(lambda (p) (/= 10 (car p))) (entget x)))) (foreach y (_s2l (ssget "_WP" pts '((0 . "insert")))) (ssdel y s)) (ssdel x s) ) ) ) (sssetfirst nil s) (princ) )

Hi, my code is updated to highlight overlapping blocks. Hopefully it's of use.

Since I'm so bored due to quarantine, I've taken quite the time to do this one: (defun c:notinside ( / *error* acadobj activeundo adoc ains alaps bb blk dets ent i ins j laprect laps maxpt minpt msg msp obname oneb orgblk pl plpt ss ssnotbl str vx x y zdet zname znames) ;; Error handling function (defun *error* ( msg ) (if (eq (type x) 'ename) (progn (vla-Highlight (vlax-ename->vla-object x) :vlax-false) (vla-update acadobj) ) ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) ;; Start function (if (setq ss (ssget '((0 . "INSERT,*POLYLINE")))) (progn (repeat (setq i (sslength ss)) (if (eq (cdr (assoc 0 (entget (setq ent (ssname ss (setq i (1- i))))))) "INSERT") (setq blk (cons ent blk)) (setq pl (cons ent pl)) ) ) (setq orgblk (length blk)) (foreach x pl ;; Get zone name (vla-Highlight (setq vx (vlax-ename->vla-object x)) :vlax-true) (while (progn (initget 1 "Name") (setq zname (entsel "\nSelect text specifying zone name for highlighted line or [Name]: ")) (cond ((null zname) (princ "\nNothing selected")) ((eq zname "Name") (setq zname (getstring T "\nSpecify name for highlighted line: ")) (if (vl-position zname znames) (progn (princ (strcat "\nName \"" zname "\" already exist. Please enter a new name")) T) (progn (setq znames (cons zname znames)) nil) ) ) ((not (wcmatch (cdr (assoc 0 (entget (car zname)))) "TEXT,MTEXT")) (princ "\nObject is not a text")) ((setq zname (cdr (assoc 1 (entget (car zname))))) (if (vl-position zname znames) (progn (princ (strcat "\nName \"" zname "\" already exist. Please enter a new name")) T) (progn (setq znames (cons zname znames)) nil) ) ) ) ) ) (vla-Highlight vx :vlax-false) (vla-update acadobj) ;; Get overlaps & Inside (vla-ZoomWindow acadobj (progn (vla-GetBoundingBox vx 'minpt 'maxpt) minpt ) maxpt ) (setq plpt (mapcar 'cdr (vl-remove-if-not '(lambda (y) (eq (car y) 10)) (entget x))) plpt (if (and (eq (cdr (assoc 70 (entget x))) 1) (null (equal (car plpt) (last plpt) 1))) (append plpt (list (car plpt))) plpt) laps (ssget "_F" plpt '((0 . "INSERT"))) ins (ssget "_CP" plpt '((0 . "INSERT"))) ains (cons ins ains) ) (mapcar '(lambda (x y / bb) (if (setq bb (ssget "_F" (list x y) '((0 . "INSERT")))) (repeat (setq j (sslength bb)) (if (ssmemb (setq ent (ssname bb (setq j (1- j)))) ss) (setq laprect (cons (apply 'JH:rectcorner (LM:ssboundingbox bb)) laprect)) ) ) ) ) (reverse (cdr (reverse plpt))) (cdr plpt) ) (vla-ZoomPrevious acadobj) (if laps (progn (repeat (setq i (sslength laps)) (if (ssmemb (setq ent (ssname laps (setq i (1- i)))) ss) (setq alaps (cons (cons zname ent) alaps)) ) ) ) ) (if ins (repeat (setq i (sslength ins)) (setq blk (vl-remove (ssname ins (setq i (1- i))) blk)) ) ) ) ;; Get Details (setq ssnotbl (JH:list-to-selset blk)) (while alaps (setq oneb (vl-remove-if-not '(lambda (x) (eq (cdr x) (cdar alaps))) alaps) dets (cons (cons (vla-get-EffectiveName (vlax-ename->vla-object (cdar alaps))) (LM:lst->str (vl-sort (mapcar 'car oneb) '(lambda (a b) (< a b))) ", ")) dets) alaps (vl-remove-if '(lambda (x) (eq (cdr x) (cdar alaps))) alaps) ) ) (setq obname (mapcar '(lambda (x) (vla-get-EffectiveName (vlax-ename->vla-object x))) blk) str (mapcar '(lambda (x) (strcat "\n" (itoa (JH:CountSpecific zdet x)) " blocks overlapping on boundaries " x " (" (LM:lst->str (mapcar '(lambda (y) (strcat (itoa (cdr y)) " " (car y))) (LM:CountItems (mapcar 'car (vl-remove-if-not '(lambda (y) (eq x (cdr y))) dets)))) ", ") ")" ) ) (LM:Unique (setq zdet (mapcar 'cdr dets))) ) msg (strcat "\nTotal number of blocks in selection: " (itoa orgblk) "\nTotal number of zones identified: " (itoa (length pl)) " (" (cond ((LM:lst->str (vl-sort znames '(lambda (a b) (< a b))) ", ")) ("")) ")" "\n" "\nNumber of blocks outside zones: " (itoa (length blk)) " (" (cond ((LM:lst->str (mapcar '(lambda (x) (strcat (itoa (cdr x)) " " (car x))) (LM:CountItems obname)) ", ")) ("")) ")" (apply 'strcat str) "\n" "\n" "\nNumber of blocks outside and overlapping: " (itoa (+ (length blk) (length dets) ) ) ) ) (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 1 msg) (cons 10 (progn (initget 1) (getpoint "\nSpecify insertion point for text: "))) '(40 . 2200) ; <--- Set text height here '(50 . 0) ) ) (foreach x (LM:UniqueFuzz laprect 1) (entmake (append '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (62 . 2) ; <--- Set color here. In this case, it's yellow. Depends on color index (43 . 300) ; <--- Set thickness here ) (apply 'append (mapcar '(lambda (y) (list (cons 10 y) '(42 . 0) '(91 . 0) ) ) x ) ) ) ) ) (sssetfirst nil ssnotbl) (princ msg) ) ) ;; End function (if activeundo nil (vla-EndUndoMark adoc)) (princ) ) (defun JH:uniqueset (lst / fin) ; Returns a unique selection set from a list of selection sets (setq fin (ssadd)) (mapcar '(lambda (x / a ent) (repeat (setq a (sslength x)) (if (null (ssmemb (setq ent (ssname x (setq a (1- a)))) fin)) (setq fin (ssadd ent fin)) ) ) ) lst ) fin ) (defun JH:CountSpecific (lst itm) ; Returns the number of items itm is inside lst. (- (length lst) (length (vl-remove itm lst)) ) ) (defun JH:rectcorner (a b) (list a (list (car b) (cadr a) (last a)) b (list (car a) (cadr b) (last a)) ) ) (defun JH:list-to-selset (lst / final) (setq final (ssadd)) (mapcar '(lambda (x) (setq final (ssadd x final))) lst) final ) ;; List to String - Lee Mac ;; Concatenates each string in a supplied list, separated by a given delimiter ;; lst - [lst] List of strings to concatenate ;; del - [str] Delimiter string to separate each item (defun LM:lst->str ( lst del / str ) (setq str (car lst)) (foreach itm (cdr lst) (setq str (strcat str del itm))) str ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l / x r ) (while l (setq x (car l) l (vl-remove x (cdr l)) r (cons x r) ) ) (reverse r) ) ;; Unique with Fuzz - Lee Mac ;; Returns a list with all elements considered duplicate to ;; a given tolerance removed. (defun LM:UniqueFuzz ( l f / x r ) (while l (setq x (car l) l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l)) r (cons x r) ) ) (reverse r) ) ;; Count Items - Lee Mac ;; Returns a list of dotted pairs detailing the number of ;; occurrences of each item in a supplied list. (defun LM:CountItems ( l / c l r x ) (while l (setq x (car l) c (length l) l (vl-remove x (cdr l)) r (cons (cons x (- c (length l))) r) ) ) (reverse r) ) ;; Selection Set Bounding Box - Lee Mac ;; Returns a list of the lower-left and upper-right WCS coordinates of a ;; rectangular frame bounding all objects in a supplied selection set. ;; sel - [sel] Selection set for which to return bounding box (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq ls1 (cons (vlax-safearray->list llp) ls1) ls2 (cons (vlax-safearray->list urp) ls2) ) ) ) (if (and ls1 ls2) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ) )

Not exactly what you wanted, but it's good for a start... (defun c:zonesblkschk ( / ss sslws ssblks i e pl txt zoneblks ii zoneblkslst zonesblkslst touchingblks touchingblkslst touchingzonesblkslst freeblks ssfree ) (vl-cmdf "_.ZOOM" "_E") (vl-cmdf "_.ZOOM" "0.75XP") (prompt "\nSelect ZONES and BLOCKS for check...") (if (setq ss (ssget)) (progn (setq sslws (ssadd) ssblks (ssadd)) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (ssadd e sslws) ) ( (= (cdr (assoc 0 (entget e))) "INSERT") (ssadd e ssblks) ) ) ) (repeat (setq i (sslength sslws)) (setq pl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget (ssname sslws (setq i (1- i))))))) (setq txt (cdr (assoc 1 (entget (ssname (ssget "_CP" pl '((0 . "*TEXT"))) 0))))) (setq zoneblks (ssget "_CP" pl '((0 . "INSERT")))) (repeat (setq ii (sslength zoneblks)) (setq zoneblkslst (cons (ssname zoneblks (setq ii (1- ii))) zoneblkslst)) ) (setq zonesblkslst (append zonesblkslst zoneblkslst)) (setq zoneblkslst nil) (setq touchingblks (ssget "_F" (if (not (equal (car pl) (last pl))) (append pl (list (car pl))) pl) '((0 . "INSERT")))) (if touchingblks (progn (repeat (setq ii (sslength touchingblks)) (setq touchingblkslst (cons (ssname touchingblks (setq ii (1- ii))) touchingblkslst)) ) (setq touchingblkslst (list txt touchingblkslst)) (setq touchingzonesblkslst (cons touchingblkslst touchingzonesblkslst)) (setq touchingblkslst nil) ) ) ) (foreach zone touchingzonesblkslst (prompt "\nOverlapping blocks of ZONE : ") (princ (car zone)) (prompt " -> : ") (princ (length (cadr zone))) (prompt " blocks...") ) (repeat (setq i (sslength ssblks)) (if (not (vl-position (ssname ssblks (setq i (1- i))) zonesblkslst)) (setq freeblks (cons (ssname ssblks i) freeblks)) ) ) (princ "\n") (prompt "\nFree blocks not inside any ZONE : ") (princ (length freeblks)) (setq ssfree (ssadd)) (foreach blk freeblks (ssadd blk ssfree) ) (sssetfirst nil ssfree) ) ) (princ) ) [EDIT : I had lack... Changed to : (setq touchingblks (ssget "_F" (if (not (equal (car pl) (last pl))) (append pl (list (car pl))) pl) '((0 . "INSERT"))))

(defun car-sort ( l f / removenth r k ) (defun removenth ( l n / k ) (setq k -1) (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l) ) (setq k -1) (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l) r ) ;;; (car-sort '(2 4 1 3 5 1) '<) => nil ;;; (car-sort '(2 4 1 3 5 1) '<=) => 1 (setq yminpt (car-sort ptlst '(lambda ( a b ) (<= (cadr a) (cadr b))))) Lee is right as usual... Consider using my (car-sort) function - should be fine with large lists, but be aware that when specifying sorting function '(lambda ( a b ) ... ) you don't use arguments the same as in (car-sort)... For ex. '(lambda ( x y ) ... ) will fail... Also, note that for comparisons you must use <= or >= instead like normal (vl-sort) < or > as like you see in example (car-sort) can't determine (< 1 1) as T and therefore return will be nil... (car-sort) will iterate just once and won't make further sorting of other elements - it will return just (car) element... Regards, M.R.

LISP is correct in both cases: boundary is LWPOLYLINE or LINE (defun DXF (code en) (cdr (assoc code (entget en)))) ;;;========================================================================= (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Ray (po V) (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 po) (cons 11 v) ) ) ) ;;;========================================================================= (defun sysvar-set (lst_setvar / strN var var_oldname n) (setq n 0 lstvar_thiep nil lstValue_thiep nil ) (repeat (/ (length lst_setvar) 2) (setq var (nth n lst_setvar) var_oldname (strcat "oldvar_thiep" (itoa n)) ) (setq lstvar_thiep (append lstvar_thiep (list var))) (set (read var_oldname) (getvar var)) (setq lstValue_thiep (append lstValue_thiep (list (read var_oldname)))) (setvar var (nth (+ n 1) lst_setvar)) (setq n (+ 2 n)) ) ) (defun Get-Area (lst ) (/ (apply '+ (mapcar '(lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) lst (cons (last lst) lst) ) ) 2 ) ) ;;;========================================================================= (defun SYSVAR-RESTORE () (mapcar '(lambda (var value) (setvar var (eval value))) lstvar_thiep lstValue_thiep ) ) ;;;========================================================================= (defun CalcZ (Pt1 Pt2 Pt3 / v w) (setq v (mapcar '- Pt1 Pt2) w (mapcar '- Pt3 Pt2) ) (- (* (car v) (cadr w)) (* (cadr v) (car w))) ) ;;;========================================================================= (defun calcThiep (po1 po2 po3 po4 / bit dis m anpha beta h obj_top poS poE) (setq anpha_org (LM:GetInsideAngle po4 po1 po2) beta_org (LM:GetInsideAngle po1 po2 po3) ) (if (< dt 0) (setq anpha anpha_org beta beta_org ) (setq anpha (- pi anpha_org) beta (- pi beta_org) ) ) (Setq bit (CalcZ po1 po4 po2)) (setq dis (distance po1 po2) ang (angle po1 po2) ) (setq m (+ (/ (cos anpha) (sin anpha)) (/ (cos beta) (sin beta)))) (setq h (abs (/ (- dis (sqrt (abs (- (* dis dis) (* 2 m (abs dt)))))) m))) (cond ((or (and (> bit 0) (> dt 0)) (and (< bit 0) (< dt 0))) (setq po5 (polar po2 (- ang (/ pi 2)) h) po6 (polar po1 (- ang (/ pi 2)) h) ) ) ((or (and (> bit 0) (< dt 0)) (and (< bit 0) (> dt 0))) (setq po5 (polar po2 (+ ang (/ pi 2)) h) po6 (polar po1 (+ ang (/ pi 2)) h) ) ) ) (setq po_in1 (inters po5 po6 po1 po4 nil) po_in2 (inters po5 po6 po2 po3 nil) ) ) (defun makeLWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (defun limS (po1 po2 po3 po4 / objL1 objL2 objR iplist) (line po4 po1) (setq objL1 (vlax-ename->vla-object (entlast))) (line po3 po2) (setq objL2 (vlax-ename->vla-object (entlast))) (cond ((> dt 0) (setq iplist (vlax-safearray->list (vlax-variant-value (vla-intersectwith objL1 objL2 3)) ) ) (vla-delete objL1) (vla-delete objL2) (SETQ A (Get-Area (list po1 po2 iplist po1))) ) ((< dt 0) (ray po4 (mapcar '- po2 po1)) (setq objR (vlax-ename->vla-object (entlast))) (if (null (vlax-invoke objR 'IntersectWith objL2 acExtendNone)) (PROGN (setq iplist (vlax-invoke objR 'IntersectWith objL2 acExtendOtherEntity ) ) (SETQ A (Get-Area (list po1 po2 iplist po4 po1))) ) (PROGN (vla-delete objR) (ray po3 (mapcar '- po1 po2)) (setq objR (vlax-ename->vla-object (entlast))) (setq iplist (vlax-invoke objR 'IntersectWith objL1 acExtendOtherEntity ) ) (SETQ A (Get-Area (list po1 po2 po3 iplist po1))) ) ) (vla-delete objL1) (vla-delete objL2) (vla-delete objR) ) ) (abs A) ) ;;;========================================================================= (defun c:dht (/ ent1_lst ent1 ent2 ent3 po1 po2 po3 po4 ang1 ang2 ang3 dis m lstpo1 lstpo2 lstpo3 lstpo-int1 lstpo-int2 anpha beta pS1 pS2 pS3 pE1 pE2 pE3 h bit obj_top poS poE po_in1 po_in2 prom Alim ) (command "undo" "be") (sysvar-set '("cmdecho" 0 "osmode" 0)) (defun *error* (msg) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (setq dt nil) (acet-ui-status) (sysvar-restore) (command "undo" "en") (princ) ) (or dt (setq dt (getcfg "AppData/trapezoid/area")) (setq dt 1000)) (acet-ui-status (setq prom (acet-str-format "\nEnter Area given for to expand (+S) or to trim (-S) <%1> : " (if (numberp dt) (rtos dt 2 3) dt ) "LOOK AT" ) ) ) (setq olddt dt) (setq dt (getreal prom)) (if (null dt) (setq dt olddt) ) (if (not (numberp dt)) (setq dt (atof dt)) ) (acet-ui-status (setq prom "\nPick a LINE (or LWPOLYLINE) edge for to expand (or to trim) area " ) "LOOK AT" ) (while (OR (NOT (setq ent1_lst (entsel prom))) (NOT (wcmatch (DXF 0 (setq ent1 (car ent1_lst))) "LINE,LWPOLYLINE")) ) (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT" ) (prompt prom) ) (acet-ui-status) (cond ((eq (DXF 0 ent1) "LINE") (acet-ui-status (setq prom "\nPick a LINE 1st edge of the trapezoid ") "LOOK AT" ) (while (OR (NOT (setq ent2 (car (entsel prom)))) (NOT (wcmatch (DXF 0 ent2) "LINE")) ) (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT" ) (prompt prom) ) (acet-ui-status (setq prom "\nPick a LINE 2nd edge of the trapezoid ") "LOOK AT" ) (while (OR (NOT (setq ent3 (car (entsel prom)))) (NOT (wcmatch (DXF 0 ent3) "LINE")) ) (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT" ) (prompt prom) ) (acet-ui-status) (setq po1 (vlax-curve-getStartpoint ent1) ;_bottom edge po2 (vlax-curve-getEndpoint ent1) ) (setq pS2 (vlax-curve-getStartpoint ent2) ;_ 1st side pE2 (vlax-curve-getEndpoint ent2) ) (setq pS3 (vlax-curve-getStartpoint ent3) ;_ 2nd side pE3 (vlax-curve-getEndpoint ent3) ) (cond ((Equal po1 ps3 1e-2) (setq po4 pE3) (cond ((Equal po2 ps2 1e-2) (setq po3 pE2)) ((Equal po2 pE2 1e-2) (setq po3 pS2)) ) ) ((Equal po1 pE3 1e-2) (setq po4 pS3) (cond ((Equal po2 ps2 1e-2) (setq po3 pE2)) ((Equal po2 pE2 1e-2) (setq po3 pS2)) ) ) ((Equal po1 ps2 1e-2) (setq po4 pE2) (cond ((Equal po2 ps3 1e-2) (setq po3 pE3)) ((Equal po2 pE3 1e-2) (setq po3 pS3)) ) ) ((Equal po1 pE2 1e-2) (setq po4 pS2) (cond ((Equal po2 ps3 1e-2) (setq po3 pE3)) ((Equal po2 pE3 1e-2) (setq po3 pS3)) ) ) ) ) ((eq (DXF 0 ent1) "LWPOLYLINE") (setq po_pick (cadr ent1_lst)) (setq po_closest (vlax-curve-getClosestPointTo ent1 po_pick)) (setq para1 (fix (vlax-curve-getParamatpoint ent1 po_closest))) (setq paraE (vlax-curve-getEndParam ent1)) (setq paraS (vlax-curve-getStartParam ent1)) (setq po1 (vlax-curve-getPointAtParam ent1 para1)) (cond ((= para1 0) (setq po4 (vlax-curve-getPointAtParam ent1 paraE) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 (+ para1 2)) ) (if (equal po1 po4 1e-3) (setq po4 (vlax-curve-getPointAtParam ent1 (- paraE 1))) ) ) ((< (1+ para1) paraE) (setq po4 (vlax-curve-getPointAtParam ent1 (- para1 1)) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 (+ para1 2)) ) ) ((= (1+ para1) paraE) (setq po4 (vlax-curve-getPointAtParam ent1 (- para1 1)) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 paraS) ) (if (equal po2 po3 1e-3) (setq po3 (vlax-curve-getPointAtParam ent1 (+ paraS 1))) ) ) ) ) ) (setq Alim (limS po1 po2 po3 po4)) (calcThiep po1 po2 po3 po4) (setvar "cecolor" "1") (makeLWPoly (list po1 po2 po_in2 po_in1 po1)) (setvar "cecolor" "256") (if (> (abs dt) Alim) (cond ((> (+ anpha_org beta_org) pi) (alert (acet-str-format "area to expand is too large (max = %1), so this case results in an area error" (rtos Alim 2 3) ) ) ) ((< (+ anpha_org beta_org) pi) (alert (acet-str-format "area to trim is too large (max = %1), so this case results in an area error" (rtos Alim 2 3) ) ) ) ) ) (setcfg "AppData/trapezoid/area" (rtos dt 2 3)) (SYSVAR-RESTORE) (command "undo" "en") (princ "ok") (princ) ) (defun LM:GetInsideAngle ( p1 p2 p3 ) ( (lambda ( a ) (min a (- (+ pi pi) a))) (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)) ) ) Extend_Trim_Area(DHT).lsp

Suggestions: