All Activity

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 block objects 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) ) Probably master Lee has some routines on his web site to copy between drawings Also , later AutoCad versions have a compare 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.

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?

I didn't know that

We invent a "bicycle", but it turns out that it already exists in an ideal version. ObjectBreakV1-0.lsp Thanks, Lee Mac!

little background on how DWG drawings work or how I understand. When you create or modify anything in a drawing it puts it at the end of drawing list. that is why you can select the last thing with (entlast) The blocks you are inserting is a made up of entity's and when you explode the block its gone but it's entity's are left in the drawing. even if its only one item its now under a different entity name. Your join command is saying join block 1 2 3 4 but you exploded them. you have to build another selection set of those entity's to join. so you create a place holder in the Drawing list with LastEnt insert and explode your block. then with the while its basically saying anything after this point in the list add to selection set SS. then pass the SS to the join command. (setq SS (ssadd)) (setq LastEnt (entlast)) (command "-insert" "*Infil_HL" '(0.0 0.0 0.0) "" "" "") (command "-insert" "*blk2" '(0.0 0.0 0.0) "" "" "") ;ent2 (command "-insert" "*blk3 '(0.0 0.0 0.0) "" "" "") ;ent3 (command "-insert" "*blk4" '(0.0 0.0 0.0) "" "" "") ;ent4 (while (setq LastEnt (entnext LastEnt)) (ssadd LastEnt SS) ) (command "_join" SS) -edit adding * infront of the block name AutoCAD inserts and immediately explodes it in one step.

Infil Panels-Layout1.pdfInfil Panels-Layout1.pdfInfil Panels-Layout1.pdfInfil Panels-Layout1.pdfInfil Panels-Layout1.pdfInfil Panels-Layout1.pdfHi All. I'm after some help with this pleasae. I want to insert 4 blocks into my drawing to form a square shape. The original 4 entities that I made are polylines and are saved as blocks in one drawing called BLOCKS_1. I start a new drawing and insert BLOCKS_1 into my drawing. This then makes the 4 polyline blocks available in my current drawing. I am then inserting the 4 blocks each at their relative 0,0,0 point which arranges the blocks how I want them. Heres where I cant get the join command to work. (I can manually join the 4 entities together using the JOIN command) After inserting the 4 blocks I am exploding them so they are now polylines and their end points are touching to form a square. this is an example of the code to only insert and explode 1 of the entities. I repeat this insert 3 more times, and change the ENTLAST to Ent2 Ent3 Ent4 (command "-insert" "Infil_HL" (0.0 0.0 0.0) "" "" "") ;Infil_HL is the block name one of the 4 entities thast are present in the drawing (setq Ent1 (entlast)) (command "_explode" Ent1) now when I run the join command it won't join the 4 entities into one. (command "_join" Ent1 Ent2 Ent3 Ent4) Regards Tony

No worries, you made a comment about the difficulty of making the desired pline, that is what I was what I was suggesting.

cough

(vl-load-com) (defun c:FOO (/ *error* acDoc ss pt y item data blocks) (defun *error* (msg) (if ss (vla-delete ss)) (if acDoc (vla-endundomark acDoc)) (cond ((not msg)) ; Normal exit ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit) ((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it ) (princ) ) (if (and (ssget "_:L" '((0 . "INSERT"))) (setq d (getreal "\nEnter Block distance: ")) ) (progn (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object))) ) (vlax-for x (setq ss (vla-get-activeselectionset acDoc)) (setq pt (vlax-get x 'insertionpoint)) (if (setq item (assoc (setq y (cadr pt)) data)) (setq data (subst (cons (car item) (append (cdr item) (list x))) item data) ) (setq data (cons (cons y (list x)) data)) ) ) (if data (foreach item data (setq blocks (vl-sort (cdr item) (function (lambda (a b) (< (car (vlax-get a 'insertionpoint)) (car (vlax-get b 'insertionpoint)) ) ) ) ) ) (setq pt (vlax-get (car blocks) 'insertionpoint)) (foreach block (cdr blocks) (vla-move block (vlax-3d-point (vlax-get block 'insertionpoint)) (vlax-3d-point (setq pt (polar pt 0.0 d))) ) ) ) ) ) ) (*error* nil) ) This works for each group of Blocks at a given Y level, based on the lowest X position in a given row as starting point.

Upload another example file to see what it looks like. But I'm afraid it can't be done easily, because you have to choose a reference point for the base block, and then rearrange the other blocks to be at equal distances. If you want to select "n" blocks, what can be a reference point from that selection set, which block? Also, they have different insertation points.

Now it works perfectly

This is an example of what Plate 2 of the Penn-Foster structural project would look like.

understood, but i have more than 10000 numbers for each CAD file

@BIGAL apologies if my query was not clear. I am trying basically to create the mtext around a house and I want the text justification to be relative to the points the user clicks. I think I will be approaching it using the three point system. e.g. if P1 & P2 angle is between between 270 to 90 then justification will be left and then check where p3 X,Y is relative to p1 X,Y to establish if top or bottom. Therefore it will be Top Left.

Do it row by row, not selecting everything.

Thanks for the prog. However, this only works for a single X row. I need to select both top and bottom rows (like Y1 and Y2), and show the result below the image.

Hi @Tamim, Try with this: (prompt "\nTo run a LISP type: reara") (princ) (defun c:reara ( / old_osmode base_blk spacing ss base_blk_pt dist_blk_lst len i ins_pt dist n dist_n x_cord y_cord new_pt) (setq old_osmode (getvar 'osmode)) (setvar 'osmode 0) (setq base_blk (car (entsel "\nPick the base block:\n")) spacing (getreal "\nEnter the spacing:\n") ) (prompt "\nSelect BLOCK's:") (setq ss (ssget (list (cons 0 "INSERT"))) base_blk_pt (cdr (assoc 10 (entget base_blk))) dist_blk_lst (list) ) (if (ssmemb base_blk ss) (ssdel base_blk ss) ) (setq len (sslength ss) i 0 ) (while (< i len) (setq ins_pt (cdr (assoc 10 (entget (ssname ss i)))) dist (distance base_blk_pt ins_pt) dist_blk_lst (cons (list dist (ssname ss i)) dist_blk_lst) i (1+ i) ) ) (setq dist_blk_lst (vl-sort dist_blk_lst (function (lambda (x1 x2) (< (car x1) (car x2))))) n 0 ) (repeat (length dist_blk_lst) (setq dist_n (- (car (nth n dist_blk_lst)) spacing (* spacing n)) x_cord (- (cadr (assoc 10 (entget (cadr (nth n dist_blk_lst))))) dist_n) y_cord (caddr (assoc 10 (entget (cadr (nth n dist_blk_lst))))) new_pt (list x_cord y_cord) ) (command-s "_move" (cadr (nth n dist_blk_lst)) "" (cdr (assoc 10 (entget (cadr (nth n dist_blk_lst))))) new_pt) (setq n (1+ n)) ) (setvar 'osmode old_osmode) (prompt (strcat "\nThe " (itoa (length dist_blk_lst)) " are rearanged!")) (princ) ) See the following video how it works. Rearange blocks.mp4 Best regards.