All Activity

Thanks for the answer ! I tested DOL and it unfortunately doesn’t solve my case. That routine keeps the single longest object from the entire selection, but it doesn’t check whether objects are collinear and overlapping. In my drawings I often have a LINE and a PLINE that lie on the same line with partial overlap; draw order puts the shorter one on top, so OVERKILL keeps the short piece. What I need is: Work with LINE and LWPOLYLINE (straight segments). Group only collinear segments whose projections overlap (within a small tolerance). In each group, keep the longest and delete the shorter overlapping pieces. Do not touch segments that are merely end-to-end (no overlap). Ignore draw order. If anyone has a LISP that does this “overlap-aware, keep-longest” behavior, I’d really appreciate it

I am hoping that you might have a simple suggestion on how to restore my workspace toolbars configuration. Hopefully I won't have to uninstall/reinstall my AutoCAD and rebuild my workspace as I'm expecting to have to.

Yep, that's what it was! I realized that it was a third party add-on from a few years ago that didn't fit my needs; uninstalled through Windows. Thank you!

If you haven't solved it yet, there's another possibility: Replace '(setq en (ssname ss cnt))' with '(setq en (ssname ss cnt)) ex en)' Load the code and run it again. Then, type '(entget ex)' on the command line. If it returns the entity list, see if '(60 . 1)' appears anywhere.

Hi @p7q, If this what you want, you can try with this: (prompt "\nTo run a LISP type: DOL (DeleteOverlappingLines)") (princ) (defun c:DOL ( / ss len i ename_length_list ename ename_length) (setq ss (ssget (list (cons 0 "*LINE"))) len (sslength ss) i 0 ename_length_list (list) ) (while (< i len) (setq ename (ssname ss i) ename_length (getpropertyvalue ename "Length") ename_length_list (append ename_length_list (list (list ename ename_length))) i (1+ i) ) ) (setq ename_length_list (vl-sort ename_length_list (function (lambda (x1 x2) (< (cadr x1) (cadr x2))))) ename_length_list (vl-remove (last ename_length_list) ename_length_list) total_len (itoa (length ename_length_list)) ) (foreach x ename_length_list (entdel (car x)) ) (prompt (strcat "\nThe total number of deleted lines is " total_len "!")) (princ) ) and you will get something like this (picture 1). Note: you need to select group by group to get only line or polyline with the highest length. Best regards.

The issue is that in my case the longest object is underneath and the shorter one is on top in the draw order. When I run OVERKILL, it keeps the top-most object, which ends up deleting my longest segment. What I need is to always keep the longest overlapping segment (LINE or PLINE) and delete the shorter one, regardless of the draw order.

I haven't forgot you, I am just swamped at work right now.

How about some more information? TableBuilder sounds like some 3rd party add-on for AutoCAD. Maybe add some screen shots or something. You should be able to uninstall the TableBuilder through Windows.

Works in AutoCAD 2026. Try restarting AutoCAD, then a reset to defaults if that doesn't work.

There is an option in OVERKILL to combine co-linear objects that partially overlap. If that's not what you need, post a before/after .dwg.

Hi everyono, I’ve tried using the OVERKILL command in AutoCAD to remove overlapping objects. However, it doesn’t have a parameter to keep only the longest object when there are overlaps. I’m looking for an AutoLISP routine that can work with LINE and PLINE (polylines), detect overlapping or collinear segments, and delete all but the longest one in each group. Thanks in advance!

Hi sir, @BIGAL It's a late reply but I try to figure out the ways as you said. I just simply made a seperate command, instead reactor based approach. That is too complicated and I'm not that much expert. I have used seperate commands to update linked texts. Now I'm trying to use this on multiple sessions while open/close and reopen the DWG file. But i couldn't fix that. Kindly help with update. Also could possible to link the attribute, block inside text contents?. (vl-load-com) ;; Global storage for set/view links (setq *set-view-links* nil) (defun c:LINKTEXT (/ set views m-handle s-handles) (prompt “\nSelect the SET TEXT or MTEXT: “) (setq set (car (entsel))) (if (and set (wcmatch (cdr (assoc 0 (entget set))) “TEXT,MTEXT”)) (progn ;; Change set text color to red for identification (entmod (subst (cons 62 1) (assoc 62 (entget set)) (entget set))) (entupd set) (setq m-handle (cdr (assoc 5 (entget set)))) ;; Select views (prompt “\nSelect VIEW TEXT or MTEXT entities: “) (setq views (ssget ‘((0 . “TEXT,MTEXT”)))) (if views (progn (setq s-handles ‘()) (repeat (sslength views) (setq ent (ssname views 0)) (ssdel ent views) (setq s-handles (cons (cdr (assoc 5 (entget ent))) s-handles)) ;; Immediately match text (vla-put-TextString (vlax-ename->vla-object ent) (cdr (assoc 1 (entget set))) ) ) ;; Store link pair in global var (setq *set-view-links* (cons (list m-handle s-handles) *set-view-links*)) (prompt “\nSet linked to views.”) ) (prompt “\nNo view text selected.”) ) ) (prompt “\nInvalid set entity.”) ) (princ) ) (defun c:SYNCSET (/ link m-ent s-handles m-obj m-text s-obj) (if *set-view-links* (progn (foreach link *set-view-links* (setq m-ent (handent (car link))) (if m-ent (progn (setq m-text (cdr (assoc 1 (entget m-ent)))) (foreach s-handle (cadr link) (setq s-obj (handent s-handle)) (if s-obj (vla-put-TextString (vlax-ename->vla-object s-obj) m-text ) ) ) ) ) ) (prompt “\nAll view texts updated from their sets.”) ) (prompt “\nNo set-view links found.”) ) (princ) ) (defun c:SELECTLINKED (/ pick handle result) (prompt “\nPick any linked text (set or view): “) (setq pick (car (entsel))) (if pick (progn (setq handle (cdr (assoc 5 (entget pick)))) (setq result (ssadd)) (foreach link *set-view-links* (cond ;; If picked is set ((equal (car link) handle) (ssadd (handent (car link)) result) (foreach s-h (cadr link) (ssadd (handent s-h) result) ) ) ;; If picked is view ((member handle (cadr link)) (ssadd (handent (car link)) result) (foreach s-h (cadr link) (ssadd (handent s-h) result) ) ) ) ) (if (> (sslength result) 0) (progn (sssetfirst nil result) (princ (strcat “\nSelected “ (itoa (sslength result)) “ linked texts.”)) ) (prompt “\nNo linked texts found.”) ) ) (prompt “\nNothing selected.”) ) (princ) ) (defun c:UNLINKVIEW (/ set views m-handle) (prompt “\nSelect SET TEXT: “) (setq set (car (entsel))) (if set (progn (setq m-handle (cdr (assoc 5 (entget set)))) (prompt “\nSelect VIEWS to unlink: “) (setq views (ssget ‘((0 . “TEXT,MTEXT”)))) (if views (foreach link *set-view-links* (if (equal (car link) m-handle) (progn (setq new-views (vl-remove-if ‘(lambda (h) (ssmemb (handent h) views)) (cadr link))) (setq *set-view-links* (subst (list m-handle new-views) link *set-view-links*)) ) ) ) (prompt “\nNo views selected.”) ) ) (prompt “\nInvalid set.”) ) (princ) ) (defun WarnIfDeletingSet (/ e) (if (and e (member (cdr (assoc 5 (entget e))) (mapcar ‘car *set-view-links*))) (alert “WARNING: You are deleting a SET text linked to other texts!”) ) ) ;; Add reactor for delete warning (vlr-command-reactor Nil ‘((:vlr-commandWillStart . (lambda (reactor cmd) (if (wcmatch (strcase cmd) “ERASE”) (progn (setq ss (ssget “_I”)) (if ss (repeat (sslength ss) (WarnIfDeletingSet (ssname ss (setq idx (1- (sslength ss))))) ) ) ) ) ) ) ) ) (prompt “\nCommands: LINKTEXT, SYNCSET, SELECTLINKED, UNLINKVIEW”) (princ)

It was working OK for me in your sample drawing - I am using 2022 though but would expect any changes in 2021 to be carried through to that. Looking at the LISP, there is nothing in there to delete any texts, try loading it last in case there is another LISP loaded with the same name as some of the sub routines and try again maybe

In Autocad 2015, the code worked correctly, in Autocad 2021, texts containing control codes are deleted after selection... Unformat not work in Autocad 2021.dwg

What I posted is for Acad, Bricscad etc. Not sure if Inventor has a TXTEXP, some one will comment.

Hi devitg.Is not rectangle but is not trapezoid too. Can any one can update the code (defun c:areacal ( / AcDoc Space nw_style js nb ent dxf_ent ptlst n old_textsize count app_txt surf cum_area pt_ins val_txt lst_bis l_4d max_d pos pt1 pt2 pt3 d1 d2 h t_spc nw_obj ent_text key label scl ht *error*) (vl-load-com) ; Define error handler (defun *error* (msg) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (setvar "OSMODE" 9) (mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1)) (if old_textsize (setvar "TEXTSIZE" old_textsize)) (vla-endundomark AcDoc) (princ) ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-startundomark AcDoc) (setvar "OSMODE" 0) ; Set scale and text height (setq scl (getvar "useri1")) (setq ht (* 0.003 scl)) ; Create ΚΕΙΜ_Layout layer if it doesn't exist (if (null (tblsearch "LAYER" "ΚΕΙΜ_Layout")) (vlax-put (vla-add (vla-get-layers AcDoc) "ΚΕΙΜ_Layout") 'color 7) ) ; Create ΚΕΙΜ_Layout text style if it doesn't exist (if (null (tblsearch "STYLE" "ΚΕΙΜ_Layout")) (progn (setq nw_style (vla-add (vla-get-textstyles AcDoc) "ΚΕΙΜ_Layout")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0) ) ) ) ; Prompt for label prefix (setq label (getstring "\nInsert prefix (π.χ A,B,C..,etc): ")) (if (eq label "") (setq label "E")) ; Select polylines (prompt "\nSelect polylines one by one (press Enter to finish): ") (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "<") (90 . 5) (-4 . "AND>")))) (if js (progn (repeat (setq nb (sslength js)) (setq ent (ssname js (setq nb (1- nb))) dxf_ent (entget ent) ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)) n (length ptlst) ) (if (eq n 4) (if (and (not (equal (rem (angle (car ptlst) (cadr ptlst)) pi) (rem (angle (caddr ptlst) (cadddr ptlst)) pi) 1E-08)) (not (equal (rem (angle (cadr ptlst) (caddr ptlst)) pi) (rem (angle (cadddr ptlst) (car ptlst)) pi) 1E-08)) ) (ssdel ent js) ) ) ) ) ) (cond ((and js (> (sslength js) 0)) (sssetfirst nil js) (initget "Yes No") (if (not (eq (getkword "\n Insert calculations [Yes/No]? <Yes>: ") "No")) (progn (sssetfirst nil nil) (setq old_textsize (getvar "TEXTSIZE") count 0 app_txt "" cum_area 0.0 ) (setvar "TEXTSIZE" ht) ; Process polylines sequentially (0 to n-1) (setq nb 0) (while (< nb (sslength js)) (setq ent (ssname js nb) dxf_ent (entget ent) ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)) n (length ptlst) pt_ins (list (/ (apply '+ (mapcar 'car ptlst)) n) (/ (apply '+ (mapcar 'cadr ptlst)) n)) val_txt (if (eq n 3) (progn (setq lst_bis (append (cdr ptlst) (list (car ptlst))) l_4d (mapcar 'distance ptlst lst_bis) max_d (apply 'max l_4d) pos (vl-position max_d l_4d) pt1 (nth pos ptlst) pt2 (nth pos lst_bis) pt3 (car (vl-remove pt2 (vl-remove pt1 ptlst))) d1 (distance pt3 (inters pt1 pt2 pt3 (polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2)) nil ) ) surf (* (atof (rtos max_d 2 2)) (atof (rtos d1 2 2)) 0.5) cum_area (atof (rtos (+ surf cum_area) 2 3)) ) (strcat label (itoa (setq count (1+ count))) " = " "1/2 x " (rtos max_d 2 2) " x " (rtos d1 2 2) " = " (rtos surf 2 2) " τ.μ.\\P" ) ) (if (and (equal (abs (- (rem (angle (car ptlst) (cadr ptlst)) pi) (rem (angle (car ptlst) (cadddr ptlst)) pi))) (* 0.5 pi) 1E-08) (equal (abs (- (rem (angle (cadr ptlst) (caddr ptlst)) pi) (rem (angle (caddr ptlst) (cadddr ptlst)) pi))) (* 0.5 pi) 1E-08) ) (progn (setq d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 2)) d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 2)) surf (atof (rtos (* d1 d2) 2 2)) cum_area (atof (rtos (+ surf cum_area) 2 2)) ) (strcat label (itoa (setq count (1+ count))) " = " (rtos d1 2 2) " x " (rtos d2 2 2) " = " (rtos surf 2 2) " τ.μ.\\P" ) ) (progn (if (equal (rem (angle (car ptlst) (cadr ptlst)) pi) (rem (angle (caddr ptlst) (cadddr ptlst)) pi) 1E-08) (setq d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 2)) d2 (atof (rtos (distance (caddr ptlst) (cadddr ptlst)) 2 2)) h (atof (rtos (distance (car ptlst) (inters (car ptlst) (polar (car ptlst) (+ (angle (car ptlst) (cadr ptlst)) (* 0.5 pi)) 1.0) (caddr ptlst) (cadddr ptlst) nil)) 2 2)) ) (setq d1 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 2)) d2 (atof (rtos (distance (car ptlst) (cadddr ptlst)) 2 2)) h (atof (rtos (distance (cadr ptlst) (inters (cadr ptlst) (polar (cadr ptlst) (+ (angle (cadr ptlst) (caddr ptlst)) (* 0.5 pi)) 1.0) (car ptlst) (cadddr ptlst) nil)) 2 2)) ) ) (setq surf (atof (rtos (* (+ d1 d2) h 0.5) 2 2)) cum_area (atof (rtos (+ surf cum_area) 2 2)) ) (strcat label (itoa (setq count (1+ count))) " = 1/2 x (" (rtos d1 2 2) " + " (rtos d2 2 2) ") x " (rtos h 2 2) " = " (rtos surf 2 2) " τ.μ.\\P" ) ) ) ) app_txt (strcat app_txt val_txt) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") (cons 8 "ΚΕΙΜ_Layout") '(100 . "AcDbText") (cons 10 pt_ins) (cons 40 ht) (cons 1 (strcat label (itoa count))) (cons 50 (angle '(0 0 0) (getvar "UCSXDIR"))) '(41 . 1.0) '(51 . 0.0) (cons 7 "ΚΕΙΜ_Layout") '(71 . 0) '(72 . 1) (cons 11 pt_ins) (assoc 210 dxf_ent) '(100 . "AcDbText") '(73 . 2) ) ) (setq nb (1+ nb)) ) (initget "1 2") (setq t_spc (getkword "\n Insert calculations[1.Modelspace/2.Paperspace]? <1>: ")) (cond ((eq t_spc "2") (vla-put-ActiveSpace AcDoc acPaperSpace) (vla-put-MSpace AcDoc :vlax-false) (setq Space (vla-get-PaperSpace AcDoc)) (setvar "TEXTSIZE" 2.5) ) (T (vla-put-ActiveSpace AcDoc acModelSpace) (if (not (eq (getvar "TILEMODE") 1)) (vla-put-MSpace AcDoc :vlax-true)) (setq Space (vla-get-ModelSpace AcDoc)) (setvar "TEXTSIZE" ht) ) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 (strcat app_txt label "ολ = " (rtos cum_area 2 2) " τ.μ.") ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation) (list 1 (getvar "TEXTSIZE") 5 "ΚΕΙΜ_Layout" "ΚΕΙΜ_Layout" 0.0) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) (setvar "TEXTSIZE" old_textsize) ) (T (sssetfirst nil nil) (princ "\nFunction canceled")) ) ) (T (princ "\nSelected items are invalid")) ) ; Reset system variables (mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1)) (setvar "OSMODE" 9) (vla-endundomark AcDoc) (princ) ) to calculate parallelepiped and if one polygon is not parallelepiped or trapezoid not allow to select it , to avoid the wrong calculation. Thanks

You should post a sample drawing.

@mhy3sx it calculate a2 as a trapezoid , because it is not a rectangle , short side are not parallel to be or no tobe a trapezoid.dwg

This code does not work in Autocad 2021 (localized version), the selected MText is being deleted. How can this be fixed? ; UnFormat MText, MLeader, Table - strip formatting contol codes from texts ; ; based on Lee Mac's UnFormat string - www.lee-mac.com/unformatstring.html ; CAD Studio, 2018, www.cadstudio.cz www.cadforum.cz ; ; (vl-load-com) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;----------------- (defun doUnformatTable (table / rowCounter colCounter) (setq rowCounter (vla-Get-Rows table)) (repeat rowCounter (setq rowCounter (1- rowCounter)) (setq colCounter (vla-Get-Columns table)) (repeat colCounter (setq colCounter (1- colCounter)) (setq cellType (vla-GetCellType table rowCounter colCounter)) (if (= cellType acTextCell)(progn (setq cellText (vla-GetText table rowCounter colCounter)) (if (/= cellText "") (vla-SetText table rowCounter colCounter (LM:UnFormat cellText T))) )) ) ; rep ) ; rep ) (defun c:UNFORMAT (/ ss ssl cnt en xxobj otyp txr ntx) (princ "\nSelect MTEXTs/DIMENSIONs/MLEADERs/TABLEs: ") (setq ss (ssget '((0 . "MTEXT,DIMENSION,MULTILEADER,ACAD_TABLE")))) (if (and ss (> (setq ssl (sslength ss)) 0))(progn (setq cnt 0) (repeat ssl (setq en (ssname ss cnt)) (setq obj (vlax-ename->vla-object en)) (setq otyp (cdr (assoc 0 (entget en)))) ; (vla-get-objectname obj)) (cond ((= otyp "MTEXT")(vla-put-TextString obj (LM:UnFormat (vla-get-TextString obj) T))) ; AcDbMText ((= otyp "DIMENSION")(vla-put-TextOverride obj (LM:UnFormat (vla-get-TextOverride obj) T))) ; AcDbRotatedDimension, AcDbAlignedDimension ((= otyp "MULTILEADER")(vla-put-TextString obj(LM:UnFormat (vla-get-TextString obj) T))) ; AcDbMLeader ((= otyp "ACAD_TABLE")(doUnformatTable obj)) ; AcDbTable ) (setq cnt (1+ cnt)) ) ;rep ) (princ "\nNothing selected!") ) ;if (princ) ) (princ "\nUNFORMAT loaded.") (princ)

Hi CivilTechSource , I test your code but if you test it in my dwg will see that calculate a2 area as trapezoid !!! Thanks

Hello! I am working in AutoCAD 2007/2008 and opened my AutoCAD this morning to find myself stuck in the TableBuilder screen which is odd because I never use TableBuilder. Anyway, can someone please help me leave the TableBuilder screen and return to my home screen where all of my tool icons reside? Thank you, Dave

We are in 2025, do we still need to show the work? Would it not be easier to write a lisp that prompts you to select each side of polygon by specifying starting and end point and then you can have the lisp do a check between if trapezoid or parallelogram and then put in text the formula substituting the lengths? The below is AI generated code that seems to work fine in terms of differentiating between triangle rectangle trapezoid and parallelogram. The mtext showing the work has some boxes not sure why. (defun C:POLYAREA (/ pt1 pt2 pt3 pt4 pts shape-type area calc-text insert-pt) ;; Function to calculate distance between two points (defun get-distance (p1 p2) (sqrt (+ (expt (- (car p2) (car p1)) 2) (expt (- (cadr p2) (cadr p1)) 2)))) ;; Function to calculate area using shoelace formula (defun shoelace-area (point-list) (setq n (length point-list)) (setq area 0.0) (setq i 0) (while (< i n) (setq j (if (= i (1- n)) 0 (1+ i))) (setq xi (car (nth i point-list))) (setq yi (cadr (nth i point-list))) (setq xj (car (nth j point-list))) (setq yj (cadr (nth j point-list))) (setq area (+ area (* xi yj))) (setq area (- area (* xj yi))) (setq i (1+ i))) (abs (/ area 2.0))) ;; Function to check if vectors are parallel (for parallelogram/rectangle check) (defun vectors-parallel (v1 v2 tolerance) (setq cross-product (abs (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2))))) (< cross-product tolerance)) ;; Function to check if vectors are perpendicular (for rectangle check) (defun vectors-perpendicular (v1 v2 tolerance) (setq dot-product (+ (* (car v1) (car v2)) (* (cadr v1) (cadr v2)))) (< (abs dot-product) tolerance)) ;; Function to get vector from two points (defun get-vector (p1 p2) (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)))) ;; Function to identify quadrilateral type (defun identify-quad (p1 p2 p3 p4) (setq v1 (get-vector p1 p2)) ; Side 1 (setq v2 (get-vector p2 p3)) ; Side 2 (setq v3 (get-vector p3 p4)) ; Side 3 (setq v4 (get-vector p4 p1)) ; Side 4 (setq tolerance 0.001) ;; Check if opposite sides are parallel (setq opposite1-parallel (vectors-parallel v1 v3 tolerance)) (setq opposite2-parallel (vectors-parallel v2 v4 tolerance)) (cond ;; Rectangle: opposite sides parallel AND adjacent sides perpendicular ((and opposite1-parallel opposite2-parallel (vectors-perpendicular v1 v2 tolerance)) "Rectangle") ;; Parallelogram: opposite sides parallel ((and opposite1-parallel opposite2-parallel) "Parallelogram") ;; Trapezoid: one pair of opposite sides parallel ((or opposite1-parallel opposite2-parallel) "Trapezoid") ;; General quadrilateral (t "Quadrilateral"))) ;; Function to create calculation text for triangle (defun triangle-calc-text (p1 p2 p3 area) (setq a (get-distance p1 p2)) (setq b (get-distance p2 p3)) (setq c (get-distance p3 p1)) (setq s (/ (+ a b c) 2.0)) ; semi-perimeter (setq sa (- s a)) (setq sb (- s b)) (setq sc (- s c)) (strcat "TRIANGLE AREA CALCULATION\\P" "Using Heron's Formula:\\P" "Side a = " (rtos a 2 3) " units\\P" "Side b = " (rtos b 2 3) " units\\P" "Side c = " (rtos c 2 3) " units\\P" "Semi-perimeter s = " (rtos s 2 3) " units\\P" "Area = √(s(s-a)(s-b)(s-c))\\P" "Area = √(" (rtos s 2 3) "×" (rtos sa 2 3) "×" (rtos sb 2 3) "×" (rtos sc 2 3) ")\\P" "Area = √" (rtos (* s sa sb sc) 2 3) "\\P" "Area = " (rtos area 2 3) " square units")) ;; Function to create calculation text for rectangle (defun rectangle-calc-text (p1 p2 p3 p4 area) (setq width (get-distance p1 p2)) (setq height (get-distance p2 p3)) (strcat "RECTANGLE AREA CALCULATION\\P" "Width = " (rtos width 2 3) " units\\P" "Height = " (rtos height 2 3) " units\\P" "Area = Width × Height\\P" "Area = " (rtos width 2 3) " × " (rtos height 2 3) "\\P" "Area = " (rtos area 2 3) " square units")) ;; Function to create calculation text for parallelogram (defun parallelogram-calc-text (p1 p2 p3 p4 area) (setq base (get-distance p1 p2)) ;; Calculate height using area formula: Area = base × height (setq height (/ area base)) (strcat "PARALLELOGRAM AREA CALCULATION\\P" "Base = " (rtos base 2 3) " units\\P" "Height = " (rtos height 2 3) " units\\P" "Area = Base × Height\\P" "Area = " (rtos base 2 3) " × " (rtos height 2 3) "\\P" "Area = " (rtos area 2 3) " square units")) ;; Function to create calculation text for trapezoid (defun trapezoid-calc-text (p1 p2 p3 p4 area) (strcat "TRAPEZOID AREA CALCULATION\\P" "Using coordinate method (Shoelace formula)\\P" "Point 1: (" (rtos (car p1) 2 3) ", " (rtos (cadr p1) 2 3) ")\\P" "Point 2: (" (rtos (car p2) 2 3) ", " (rtos (cadr p2) 2 3) ")\\P" "Point 3: (" (rtos (car p3) 2 3) ", " (rtos (cadr p3) 2 3) ")\\P" "Point 4: (" (rtos (car p4) 2 3) ", " (rtos (cadr p4) 2 3) ")\\P" "Area = ½|∑(xᵢyᵢ₊₁ - xᵢ₊₁yᵢ)|\\P" "Calculation: ½|(" (rtos (car p1) 2 3) "×" (rtos (cadr p2) 2 3) "-" (rtos (car p2) 2 3) "×" (rtos (cadr p1) 2 3) ") + " "(" (rtos (car p2) 2 3) "×" (rtos (cadr p3) 2 3) "-" (rtos (car p3) 2 3) "×" (rtos (cadr p2) 2 3) ") + " "(" (rtos (car p3) 2 3) "×" (rtos (cadr p4) 2 3) "-" (rtos (car p4) 2 3) "×" (rtos (cadr p3) 2 3) ") + " "(" (rtos (car p4) 2 3) "×" (rtos (cadr p1) 2 3) "-" (rtos (car p1) 2 3) "×" (rtos (cadr p4) 2 3) ")|\\P" "Area = " (rtos area 2 3) " square units")) ;; Main program starts here (princ "\\nPolygon Area Calculator") (princ "\\nSelect points in order (clockwise or counterclockwise)") ;; Get first point (if (setq pt1 (getpoint "\\nSelect first point: ")) (progn ;; Get second point (if (setq pt2 (getpoint pt1 "\\nSelect second point: ")) (progn ;; Get third point (if (setq pt3 (getpoint pt2 "\\nSelect third point: ")) (progn ;; Check if user wants to add a fourth point (setq pt4 (getpoint pt3 "\\nSelect fourth point (or press Enter for triangle): ")) (if pt4 ;; Four points - quadrilateral (progn (setq pts (list pt1 pt2 pt3 pt4)) (setq shape-type (identify-quad pt1 pt2 pt3 pt4)) (setq area (shoelace-area pts)) ;; Create appropriate calculation text (cond ((= shape-type "Rectangle") (setq calc-text (rectangle-calc-text pt1 pt2 pt3 pt4 area))) ((= shape-type "Parallelogram") (setq calc-text (parallelogram-calc-text pt1 pt2 pt3 pt4 area))) (t (setq calc-text (trapezoid-calc-text pt1 pt2 pt3 pt4 area)))) (princ (strcat "\\nShape identified: " shape-type)) (princ (strcat "\\nArea: " (rtos area 2 3) " square units"))) ;; Three points - triangle (progn (setq pts (list pt1 pt2 pt3)) (setq shape-type "Triangle") (setq area (shoelace-area pts)) (setq calc-text (triangle-calc-text pt1 pt2 pt3 area)) (princ (strcat "\\nShape identified: " shape-type)) (princ (strcat "\\nArea: " (rtos area 2 3) " square units")))) ;; Get insertion point for MText (if (setq insert-pt (getpoint "\\nSelect point to insert calculation text: ")) (progn ;; Create MText entity (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 insert-pt) ; insertion point (cons 40 2.5) ; text height (cons 41 50.0) ; reference rectangle width (cons 71 1) ; attachment point (top left) (cons 72 5) ; drawing direction (cons 1 calc-text) ; text string (cons 7 "STANDARD") ; text style (cons 210 '(0.0 0.0 1.0)))) ; normal vector (princ "\\nCalculation text inserted successfully!")) (princ "\\nText insertion cancelled."))) (princ "\\nThird point required.")) (princ "\\nSecond point required.")) (princ "\\nFirst point required.")) (princ)) ) ) ;; Command to run the function (princ "\\nPolygon Area Calculator loaded. Type POLYAREA to run.") (princ)

BREAKUP is somewhat different from EXPLODE. BREAKUP is used to break a single object into its component parts without losing the original object’s properties. This command is particularly useful for complex objects like polylines, blocks, or other grouped entities. It allows you to manipulate individual components of an object while maintaining the overall integrity of the drawing. Not really sure what the real world difference would be if the "properties" are not needed after exploding. IIRC, it's useful for EXPLODING i.e. some of the Symbols, etc. from Mechanical and other verticals without losing the properties.

Thank you so much! After playing with lisp for over a two months now I am so happy that I can understand the above!

Hi devitg, You delete parts of the original code . I use ; Set scale and text height (setq scl (getvar "useri1")) (setq ht (* 0.00003 scl)) To set the scale for a lot of the lisp I use , and I need this part too (initget "1 2") ;;; (setq t_spc (getkword "\n Insert calculations[1.Modelspace/2.Paperspace]? <1>: ")) I test the code you upload but The calculation on trapezoid is not fixed because can not understand that the paralilogram (a2) is not a trapezoid (a1) because the code check only if the lines is pararell and calculate the area of the trapezoid. Perhaps need son anngle check to understamd if it is paralilogram or trapezoid. Thanks