All Activity

Another important detail: in the circles, the resulting arc that will be modified depends on whether the cut points are indicated in a clockwise or counterclockwise direction. If they are selected in the opposite direction from what is needed to obtain the desired result, it can be immediately switched by pressing TAB key (as indicated in the command line).

I think I read your first explanation too quickly. I also thought about keeping the main part of your code to avoid overcomplicating my answer. But in the end, I decided to spend a little time improving the code. Here's another option for doing this task. One possible difference (or not) with the other options discussed in this thread is that the cut points may or may not be on the object to be cut: when they aren't, it will calculate the perpendicular point. Another small difference is that here, you're still required to first select the object to be modified to avoid the problem of cases where several objects coincide at the same point. (defun c:Br2ptReplDash (/ para tl ss pt1 pt2 p1 p2 ent vlae ep to c r eumk entdata newent entUlt osmant ecoA lstChg lstR lent1 lent pIni pFin dameSeg *troca* erroria errores error0 ) (defun erroria () (defun errores (mens) (setq *error* error0) (command-s "._undo" "_1") (prin1) ) (setq error0 *error* *error* errores ) ) (defun dameSeg (e p1 p2 / vlae pIni pFin rg) (setq pIni (vlax-curve-getPointatParam (setq vlae (vlax-ename->vla-object e)) (vlax-curve-getStartParam vlae)) pFin (vlax-curve-getPointatParam vlae (vlax-curve-getEndParam vlae)) rg (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) 1.01) ) (if (and (or (equal p1 pIni rg) (equal p1 pFin rg) ) (or (equal p2 pIni rg) (equal p2 pFin rg) ) ) T ) ) (defun grreadea (/ para lr ) (while (not para) (princ "\rPress TAB to switch modifications, Select next object to split or RIGHT CLICK to EXIT...") (setq lr (grread T 4 2)) (cond ((= (car lr) 2) (cond ((= (cadr lr) 9) (setq *troca* (not *troca*)) (entmod (append (if *troca* lent lent1) lstChg)) (entmod (append (if *troca* lent1 lent) lstR)) ) ) ) ((= (car lr) 25) (setq para 0 ep nil) ) ((= (car lr) 3) (if (listp (cadr lr)) (setq ep (nentselp (cadr lr)) ep (if (wcmatch (cdr (assoc 0 (entget (car ep)))) "*LINE,ARC,CIRCLE") ep) para (if ep T) ) ) ) (T (if (/= (car lr) 5) (print lr) )) ) ) para ) (erroria) (setq osmant (getvar "OSMODE") ecoA (getvar "CMDECHO") eumk nil tl "DASHED2" tl (if (tblsearch "LTYPE" tl) tl (progn (vlr-beep-reaction) (alert (princ (strcat "\n*** Linetype " tl " not found. It will be instead CONTINUOUS"))) "CONTINUOUS" ) ) lstChg (list '(8 . "0") ; the default layer (cons 6 tl) ; line type '(48 . 0.25) ; thickness '(62 . 84) ; color ) ) (setvar "CMDECHO" 0) (while (and (not para) (or ep (setq ss (SETVAR "NOMUTT" 1) ss (princ "\nSelect object to trim (RIGH CLICK to EXIT)...") ss (ssget "_+.:E:S" '((0 . "*LINE,POLYLINE,CIRCLE,ARC"))) ) ) ) (SETVAR "NOMUTT" 0) (setq entUlt (entlast)) (princ "\nSelect the object to split...") (setq ent (if ep (car ep) (ssname ss 0)) lstR (list (cons 6 (if (assoc 6 (entget ent)) (cdr (assoc 6 (entget ent))) "BYLAYER")) (cons 48 (if (assoc 48 (entget ent)) (cdr (assoc 48 (entget ent))) 1.0)) (cons 62 (if (assoc 62 (entget ent)) (cdr (assoc 62 (entget ent))) 256)) ) ) (setq pt1 (getpoint "\nSelect the first break point: ") ;; Entering the first break point pt2 (getpoint "\nSelect the second break point: ") ;; Entering the second break point ep nil ) (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object))) ;; Checking the object type and performing the split (cond ((wcmatch (setq to (cdr (assoc 0 (entget ent)))) "*LINE") ;; break polyline (setq pt1 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt1) pt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt2) ) (command "_.BREAK" ent pt1 pt2) (command "_.LINE" pt1 pt2 "") (entmod (append (ENTGET (ENTLAST)) lstChg)) ) ((= to "CIRCLE") ;; break the circle (setvar "OSMODE" 0) (entmake (entget ent)) (command "_.BREAK" ent pt1 pt2) (command "_.BREAK" (entlast) pt2 pt1) (setq lent (entget ent)) (entmod (append (setq lent1 (entget (entlast))) lstChg)) (setq para (= 0 (grreadea))) ) ((= to "ARC") ;; break the arc (setvar "OSMODE" 0) (setq ;ent1 (entmake (entget ent)) pIni (vlax-curve-getPointatParam (setq vlae (vlax-ename->vla-object ent)) (vlax-curve-getStartParam vlae)) pFin (vlax-curve-getPointatParam vlae (vlax-curve-getEndParam vlae)) pt1 (polar (setq c (cdr (assoc 10 (setq lent (entget ent))))) (angle c pt1) (setq r (cdr (assoc 40 lent)))) pt2 (polar c (angle c pt2) r) ) (command "_.BREAK" ent pt1 pt1) (if (equal (car (nentselp pt2)) (setq ent1 (entlast))); SI P2 EST脕 SOBRE LA NUEVA ENTIDAD CREADA (command "_.BREAK" ent1 pt2 pt2) (command "_.BREAK" ent pt2 pt2) ) (entmod (append (entget (if (dameSeg (setq ent2 (entlast)) pt1 pt2) ent2 ent1)) lstChg)) ) (T (prompt "An object of an unsupported type.") ) ) (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object))) (setq eumk T) (setvar "OSMODE" OSMANT) ) (if ecoA (setvar "CMDECHO" ecoA)) (if (not entUlt) (princ "\nObjects are not selected.")) (princ) )

thanks.

RE: PNO lisp: Can additional attributes be added to factor the outcome of Incremental numbers? When I review the PNO lisp I keep wondering, can the results of assigned incremental number in "Port_Number" attribute be secondarily ordered by a 2nd attribute "Sort_Order2" value after the 1st "Sort-Order" value? AND possibly by 3rd priority sort of 3rd attribute's alphabetic value in a 3rd attribute "Sort_Order3"? These option, if possible, would allow more control of the assigned incremental numbers. Attached is blocks as example. PNO TEST-LSP FOR NUMBING2.dwg

There are some LISPs/programs out there. AutoCAD Architecture FREE toolset has the AECLINEWORKSHRINKWRAP command. Or... Polyline Outline (Advanced) | Lee Mac Programming. Maybe this... TotalBoundary • Outline creation tool - Programs and Scripts - AutoCAD Forums Maybe something in this thread...

There are some LISPs/programs out there. AutoCAD Architecture FREE toolset has the AECLINEWORKSHRINKWRAP command. Or... Polyline Outline (Advanced) | Lee Mac Programming. Maybe this... TotalBoundary • Outline creation tool - Programs and Scripts - AutoCAD Forums Maybe something in this thread...

Slight different way of looking at this - back to OPs original problem of how to select the entities - instead of insert and explode, load the block into the drawing and grab the entities it contains from there. The block doesn't need to be inserted, that can come shortly. This will insert the exploded block (for most simple entities, not tested fully) The selection set MyAllSS contains all the inserted entities, so I think (command "join" .... ) will join everything together You'll have to adjust the BlockName list. (defun c:SSBlockEntities ( / BlockName acount MyEnts MyAllSS MySS MyEnt NewEnt) ;;Sub routines ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-to-select-all-entities-inside-of-a-block/td-p/10284294 (defun blockcomponents ( blk / ent rtn ) (if (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (setq rtn (cons ent rtn)) ) ) (reverse rtn) ) ;; End subroutines (setq BlockName '( "CircuitBreaker" "CT")) ;; Block Names to assess (setq MyAllSS (SSAdd)) ;; Blank Selection set - all entities, all blocks (foreach n BlockName (setq MySS (SSAdd)) ;; Blank Selection set (setq acount 0) ;; A counter (setq MyEnts (blockcomponents n)) ;; Entity list for block (while (< acount (length MyEnts)) ;; Loop this block (setq MyEnt (entget (nth acount MyEnts))) ;; nth entity description (setq NewEnt (entmakex MyEnt)) ;; Make a new entity (ssadd NewEnt MySS) ;; Add entity to selection set (ssadd NewEnt MyAllSS) ;; Add entity to selection set - all entities, all blocks (setq acount (+ acount 1)) ;; Increase Loop ) ; end while ;; Or do command 'Move' and 'rotate' on MySS selection set here: (command "move" MySS "" '(0 0 0) pause "") (command "rotate" MySS "" (getvar 'lastpoint) pause) ) ; foreach n (princ) ; exit quietly )

This code works, but you need to remember that for a CIRCLE and an ARC, you need to select points clockwise. ;; AutoLISP, which allows you to select objects (line, polyline, circle, arc), ;; break them at two points and replace the selected section with a dashed line with the specified parameters ;; **CIRCLE and ARC needs to be selected in an anti clockwise direction. Clockwise gives a big arc** ;; https://www.cadtutor.net/forum/topic/98693-break-an-object-at-2-points-and-replace-the-properties-of-the-line/ ;; The source code of the author is BIGAL (defun c:brkobjLN-CIR ( / ent ent1 pt1 pt2 type obj1 rad cenpt ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 183) (setq ent (entsel "Pick object to break at: ")) (if ent (progn (setq ent1 (car ent)) (setq pt1 (getpoint "Pick first point: ")) (setq pt2 (getpoint "Pick second point: ")) (setq type (cdr (assoc 0 (entget ent1)))) (command "_.break" ent1 pt1 pt2) (cond ((or (= type "LINE") (= type "LWPOLYLINE")) (command "_.line" pt1 pt2 "") (command "_.chprop" (entlast) "" "_LT" "DASHED2" "_C" 5 "_LW" 0.25 "_S" 10 "") ) ((= type "ARC") (setq obj1 (vlax-ename->vla-object ent1)) (setq rad (vlax-get obj1 'radius)) (setq cenpt (vlax-get obj1 'center)) (command "_.arc" pt1 "_C" cenpt pt2) (command "_.chprop" (entlast) "" "_LT" "DASHED2" "_C" 5 "_LW" 0.25 "_S" 10 "") ) ((= type "CIRCLE") (setq obj1 (vlax-ename->vla-object ent1)) (setq rad (vlax-get obj1 'radius)) (setq cenpt (vlax-get obj1 'center)) (command "_.arc" pt1 "_C" cenpt pt2) (command "_.chprop" (entlast) "" "_LT" "DASHED2" "_C" 5 "_LW" 0.25 "_S" 10 "") ) ) ) ) (setvar 'osmode oldsnap) (princ) )

Thanks, at the stage of setting the properties of the line, this does not happen automatically, but requests for color, layer, line weight, and so on appear on the command line...

Found some time have a look at this not finished but draws tabs. Save Multi getvals.lsp to a support path. ; https://www.cadtutor.net/forum/topic/98697-autocad-join-command/ ; Draw tabs on a rectang ; By AlanH Sept 2025 (defun c:wow ( / oldsnap pt1 pt2 pt3 pt4 pt5 pt6 ssadd) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values " "length" 5 4 "200" "Width " 5 4 "200" "Tab height" 5 4 "20" "Tab width" 5 4 "20" "Tab edge dist" 5 4 "15"))) (setq len (atof (nth 0 ans)) ht (atof (nth 1 ans)) tabht (atof (nth 2 ans)) tabwid (atof (nth 3 ans)) tabedge (atof (nth 4 ans)) ) (setq pt1 (getpoint "\nPick point bottom left ") pt2 (mapcar '+ pt1 (list len 0.0 0.0)) pt3 (mapcar '+ pt1 (list len ht 0.0)) pt4 (mapcar '+ pt1 (list 0.0 ht 0.0)) ) (command "rectang" pt1 pt3) (setq ent1 (entlast)) (setq pt5 (mapcar '+ pt1 (list 0.0 tabedge 0.0))) (setq pt6 (mapcar '+ pt1 (list 0.0 (+ tabedge tabwid) 0.0))) (command "Break" ent1 pt5 pt6 ) (setq pt7 (mapcar '+ pt5 (list (- (- tabwid (/ tabht 2.0))) 0.0 0.0))) (setq pt8 (mapcar '+ pt6 (list (- (- tabwid (/ tabht 2.0))) 0.0 0.0))) (setq mp (mapcar '* (mapcar '+ pt7 pt8) '(0.5 0.5))) (command "pline" pt6 pt8 "a" pt8 "CE" mp pt7 "L" pt5 "") (setq pt5 (mapcar '+ pt4 (list 0.0 (- tabedge) 0.0))) (setq pt6 (mapcar '+ pt4 (list 0.0 (- (+ tabedge tabwid)) 0.0))) (command "Break" ent1 pt5 pt6 ) (setq pt7 (mapcar '+ pt5 (list (- (- tabwid (/ tabht 2.0))) 0.0 0.0))) (setq pt8 (mapcar '+ pt6 (list (- (- tabwid (/ tabht 2.0))) 0.0 0.0))) (setq mp (mapcar '* (mapcar '+ pt7 pt8) '(0.5 0.5))) (command "pline" pt5 pt7 "a" pt7 "CE" mp pt8 "L" pt6 "") (setq pt5 (mapcar '+ pt3 (list 0.0 (- tabedge) 0.0))) (setq pt6 (mapcar '+ pt3 (list 0.0 (- (+ tabedge tabwid)) 0.0))) (command "Break" ent1 pt5 pt6 ) (setq pt7 (mapcar '+ pt5 (list (- tabwid (/ tabht 2.0)) 0.0 0.0))) (setq pt8 (mapcar '+ pt6 (list (- tabwid (/ tabht 2.0)) 0.0 0.0))) (setq mp (mapcar '* (mapcar '+ pt7 pt8) '(0.5 0.5))) (command "pline" pt6 pt8 "a" pt8 "CE" mp pt7 "L" pt5 "") (setq pt5 (mapcar '+ pt2 (list 0.0 tabedge 0.0))) (setq pt6 (mapcar '+ pt2 (list 0.0 (+ tabedge tabwid) 0.0))) (command "Break" ent1 pt5 pt6 ) (setq pt7 (mapcar '+ pt5 (list (- tabwid (/ tabht 2.0)) 0.0 0.0))) (setq pt8 (mapcar '+ pt6 (list (- tabwid (/ tabht 2.0)) 0.0 0.0))) (setq mp (mapcar '* (mapcar '+ pt7 pt8) '(0.5 0.5))) (command "pline" pt5 pt7 "a" pt7 "CE" mp pt8 "L" pt6 "") (setq topr (mapcar '+ pt3 (list (+ tabwid 1.0) 1.0 0.0))) (setq botl (mapcar '+ pt1 (list (- (+ tabwid 1.0)) -1.0 0.0))) (command "join" "w" topr botl "") (setvar 'osmode oldsnap) (princ) ) (c:wow) Multi GETVALS.lsp

Description: I have a sample drawing where: The outer boundary is in red color (closed polyline). Inside this boundary, there are several cross polylines (in white). Some of these inside polylines are offsets or overlapping. My Requirement: I want to keep only the outermost polyline inside the boundary. The inner offset/cross polylines should be trimmed or deleted automatically. The result should leave only the clean outer boundary and remove the unwanted inner lines. Sample.dwg

"PI" is a valid lisp reserved variable so no need to work out all the angle values as decimal values. 0=0 90= (/ pi 2.) = 1.5707963267949 180= pi 270 = (* 1.5 pi) 45 = (* pi 0.25) and so on, in code where lots of hor and ver angles are used can just pre-set angles eg (setq a90 (/ pi 2.))

If all the objects touch ie no gaps, then this method should work, you draw a random closed pline around your objects, use BPOLY pick a point inside this dummy outer pline, two new plines will be made, erase the dummy and the new pline at the outer, you should now have a new pline wrapped around your objects.

I agree with @SLW210 why not just draw it, you just need to make a front end for input. This movie shows an example that is way more complex than your shape. Do windows.mp4 If you define the variables required like lengths A & B & C etc then a program could be done pretty quick. I have a Make a DCl lisp that could be used to make the front end input DCL. It looks like Length & Height, Tab widths & offset from ends, Slot sizes. Pretty simple all objects would be plines. Oh yeah all dimmed. It could also be made as a Dynamic block. Why not have a go, good task about learning lisp, as basic shapes to be made.

thought I had saved updated code, ,but it did not updated above check the defun line for the space.

not sure what you want to accomplish with this? would a simple insert not do the same. You could retrieve all objects after explode : Your code won't work this way but nice try. If you want to copy object between drawings it would work something like this : ;;; copy selectionset to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all objects from SS in a list (foreach object (ss->ol ss) (setq object-list (cons object object-list))) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) (defun c:t1 ( / ss d) (if (and (setq ss (ssget)) (setq d (getfiled "Copy SS to:" "" "dwg" 0))) (ctd ss d) ) (princ) ) the other way around (very little error trapping , like selected drawing must be closed) : ;;; copy from (dbx) drawing (all objects / all layouts) (defun cfd ( / acApp acDoc dbx dwg object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (setq dwg (getfiled "Copy (all) objects from :" "" "dwg" 0)) (vla-open dbx dwg) (vlax-for block (vla-get-blocks dbx) (vlax-for object block (setq object-list (cons object object-list)) ) ) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects from dbx-drawing to active drawing (vla-CopyObjects dbx object-safe-array (vla-get-ModelSpace acDoc)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (princ) ) Probably master Lee also has some routines on his web site to copy between drawings Latest AutoCad versions have a compare drawing command?

What I did when having to compare warehouse layouts is saving them out as old and new flatting everything and change the old to light gray and the new to blue. inserting them as xref. -edit looks like this is a built in feature now https://help.autodesk.com/view/ACD/2025/ENU/?guid=GUID-2D69E78D-5C82-464F-B864-CD29D5720EB9 https://help.bricsys.com/en-us/document/bricscad/managing-drawings/comparing-drawings?version=V25&id=165079151370

Haven't looked at the code but FYI. Entity names are generated when the drawing is open making them unique and random and only valid for that drawing. You can't save an entity name's and call it later when a drawing is closed or use entget with that entity name from another drawing. -edit So a circle in two drawings with everything the same layer, color, xyz location will have two different entity names. <Entity name: 1A3F5B7C> <Entity name: 2B8E4D9A>

I finally figured it out using angles and 3 point system similar to UCS. I took it a step further and added option for prefix and suffix as at my work we add the plus icon as a spot level marker. Let me know what you think. Any suggestions to improved the code make it more lean are welcomed. (defun c:LE-CalExtFFL ( / pt1 pt2 pt3 TxtRotation TxtJustification radians degrees pi) (command "_layer" "_m" "-LE-E-External Levels" "") (setq Prefix "") (setq Suffix "") (setq ffl-ent (car (entsel))) (if (and ffl-ent (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT")) (progn ;; 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)) (if ffl-value (progn (setq SpotLevel (- ffl-value 0.15)) ;; Initialize point list (setq pt-list '()) ;; Prompt for points where to place the new MText (princ "\nSelect points where to place the level text (Press Enter to finish): ") ) ) ) ) (setq pi 3.141592653589793) (setq TxtJustification 1) (setq TxtRotation 0) (setq pt1 (getpoint "\nSelect first point: ")) (setq pt2 (getpoint "\nSelect second point: ")) (setq pt3 (getpoint "\nSelect third point for rotation reference: ")) (setq TxtRotation (angle pt1 pt2)) (setq TxtValue SpotLevel) (DefMTextJustification pt1 pt2 pt3 ) (CreateMText pt1 TxtValue TxtRotation TxtJustification) ) (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 (princ "\nError: Could not extract numeric value from FFL text.") nil ) ) ) (defun DefMTextJustification ( p1 p2 p3 / ) ;; 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 (if (or (and (>= (angle p1 p2) 0.0) (<= (angle p1 p2) 1.570796327)) (>= (angle p1 p2) 4.71238898)) (progn (setq TxtJustification 1) (setq Prefix "+") (setq Suffix "") (if (> (angle p1 p3) (angle p1 p2)) (progn (setq TxtJustification 7) (setq Prefix "+") (setq Suffix "") (if (and (= (angle p1 p2) 0.0) (> (angle p1 p3) 4.71238898)) (progn (setq TxtJustification 1) (setq Prefix "+") (setq Suffix "") ) ) ) ) ) (progn (setq TxtJustification 3) (setq Prefix "") (setq Suffix "+") (setq TxtRotation (+ TxtRotation pi)) ;;Set Justification to Bottom (if (> (angle p1 p3) (angle p1 p2)) (progn (setq TxtJustification 3) (setq Prefix "") (setq Suffix "+") ) (progn (setq TxtJustification 9) (setq Prefix "") (setq Suffix "+") ) ) ) ) ) (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 )

Hi everyone, I wrote an AutoLISP program that extracts a DWG’s contents into the current drawing without opening the file. Since VLA_OBJECTs are limited, I used entget, but AutoCAD crashes with a Fatal Error. Does anyone know what might be wrong or which part of the code I should fix? (defun MT:GetFileD (title lastPath defaultfile ext flag /) (or (= 'STR (type defaultfile)) (setq defaultfile "")) (if (= 'STR (type lastPath)) (setq defaultfile (strcat lastPath "\\" defaultfile)) ) (getfiled title defaultfile ext flag) ) (defun MT:GetEntgetListFromDwg (dwgfilename / doc ss entgetlist) (if (setq dwgfilename (findfile dwgfilename)) (progn (setq doc (vla-open (vla-get-Documents (vlax-get-acad-object)) dwgfilename :vlax-false)) (setq entgetlist '()) (setq ss (vla-get-ModelSpace doc)) (vlax-for obj ss (setq entgetlist (cons (entget (vlax-vla-object->ename obj)) entgetlist)) ) (vlax-release-object ss) (setq ss nil) (vla-close doc) (vlax-release-object doc) ) ) entgetlist ) (defun MT:RefineEntgetList (entgetlist / item) (foreach item entgetlist (setq newitem (vl-remove (assoc -1 item) item)) (setq newitem (vl-remove (assoc 330 item) newitem)) (setq newitem (vl-remove (assoc 5 item) newitem)) (setq entgetlist (subst newitem item entgetlist)) ) entgetlist ) ;;;(c:CompareDwgs) (defun c:CompareDwgs (/ regKey lastPath mainfile revisedfile entlist-main entlist-revised entlist-first entlist-second entlist-both ss ent ) ;; registry key to store last path (setq regKey "HKEY_CURRENT_USER\\Software\\Ahankhah\\CompareDwgs") (setq lastPath (vl-registry-read regKey "LastPath")) ;; ask user for first file (setq mainfile (MT:GetFileD "Select main drawing" lastPath "main.dwg" "dwg" 0)) ;; if user cancelled, exit gracefully (if (not mainfile) (progn (princ "\nOperation canceled by user.") (princ)) ;; else proceed to ask for second file (progn (setq lastPath (vl-filename-directory mainfile)) (vl-registry-write regKey "LastPath" lastPath) ;; use folder of first file as default for second (setq revisedfile (MT:GetFileD "Select revised drawing" lastPath "revised.dwg" "dwg" 0)) ;; if user cancelled selecting second file, exit gracefully (if (not revisedfile) (progn (princ "\nOperation canceled by user.") (princ)) ;; else we have both files — save last path (folder of second) and continue (progn (setq lastPath (vl-filename-directory revisedfile)) (vl-registry-write regKey "LastPath" lastPath) (setq entlist-main (MT:GetEntgetListFromDwg mainfile)) (setq entlist-revised (MT:GetEntgetListFromDwg revisedfile)) (setq entlist-first (MT:RefineEntgetList entlist-main)) (setq entlist-second (MT:RefineEntgetList entlist-revised)) (setq entlist-both '()) (foreach elist entlist-first (if (member elist entlist-second) (progn (setq entlist-first (vl-remove elist entlist-first)) (setq entlist-second (vl-remove elist entlist-second)) (setq entlist-both (cons elist entlist-both)) ) ) ) (princ "\nComparison done. Lists are ready.") (foreach elist entlist-both (entmakex elist)) (foreach elist entlist-first (if (assoc 62 elist) (setq elist (subst (cons 62 1) (assoc 62 elist) elist)) (setq elist (append elist (list (cons 62 1)))) ) (entmakex elist) ) (foreach elist entlist-second (if (assoc 62 elist) (setq elist (subst (cons 62 2) (assoc 62 elist) elist)) (setq elist (append elist (list (cons 62 2)))) ) (entmakex elist) ) (princ) ) ; end else have revisedfile ) ; end if revisedfile ) ; end else have mainfile ) ; end if mainfile )

Always check lee mac's website first. might not work if all objects are not touching.

Hı Everyone I’m looking for an AutoLISP routine that can take a selection of objects (LINE, LWPOLYLINE, POLYLINE, etc.) and generate a single outer boundary (contour) that follows the outermost edges of these objects. The goal is to merge or outline only the outermost edges of all selected entities, ignoring any internal edges or overlaps. The resulting outer contour should be a closed polyline if possible. The type or layer of the original objects doesn’t matter — only their geometry matters. Has anyone developed or seen a routine like this, or could point me in the right direction? Thanks in advance!

Good tip.

@Steven P I used it mostly for inserting text in blocks that need to be specific fonts, spacing, layers , and color. a side note even tho the blocks are exploded they are in the block library until you purge. keep that in mind when using generic block names. pasting a block from a different drawing will pull from the block library instead if they have the same name not the clipboard. So if block1 is a circle in DrawingA and a square in DrawingB. Selecting the block in drawingA and copy paste into DrawingB when it paste all the blocks will be squares. not the circles you copied.

Good stuff @mhupp! OP, why not just draw the polylines with LISP?