Leaderboard

Or if you need it to be something other than 45 degrees: (polar '(0 0 0) (cvunit <your_angle_in_degrees> "degrees" "radians") 10)

This only assumes the horizontal and vertical lines are drawn in UCS, and not WCS: (defun c:vmirror nil (OnePointMirror '(00 10 00))) (defun c:hmirror nil (OnePointMirror '(10 00 00))) (defun OnePointMirror (dir / ss pt) (and (setq ss (ssget "_:L")) (setq pt (getpoint "\nSpecify base point <exit>: ")) (command "_mirror" ss "" "_non" pt "_non" (mapcar '+ dir pt) "No") ;; <--- Change to Yes to delete source object, or \\ to prompt user. (while (not (zerop (getvar "cmdactive"))) (command "")) ) (princ) ) And while this may be off the OP, this might be worth looking at as well: Quick Mirror.

@pkenewell Though this might sound silly (and to my knowledge), I haven't found a method in which you use a script or macro to select all objects in a layer devoid of AutoLISP. And QSELECT uses a GUI to prompt the user, so it's impossible to use that in a macro or script. Perhaps someone can correct me on this.

It's not even the pop-up in itself that's tedious, but rather the whole logic to perform the calculations to find the overlaps is in itself already a very tedious task. This is because you are involving multiple object types in your calculations. What you're trying to accomplish is not an easy task. In the meantime, you can have a look at this program Block Overkill which only process blocks (and that in itself is already a lot).

After hours of frustration, I found this bit of code and it works. Of course. Lee Mac is da bomb. We're not worthy!!

which is exactly why we do this!!

Try this: (defun c:test3 ( / pt pt1) (setq pt (getpoint)) ;;get point in paper space ; (setq pt1 (trans pt 3 0)) (command "._MSPACE") (setq e (car (last (nentselp (cadr (grread t)))))) (command "._PSPACE") (princ e) (entget e) ) nentselp, like nentsel, returns a list, the first item, (car ) is the nested entity that was selected - so if you select a block it will be maybe the line within the block, info on the next two are online, the last item in the list is the parent entity - in your case the complete block "Welding Elbow"... so add a (last ) into the code to get that

Just to give a final update. The code above caused Intellicad to crash frequently while testing. In the end I had to give up using it, I believe the problem stems from the VL code though I can't be certain. I then did a bit of research on 'foreach' and have settled on this: (defun create-blocks-for-layers (/ lay lst blk_name_prefix filepath layer_name sel blk_name ) ; (while (setq lay (tblnext "layer" (null lay))) (setq lst (cons (cdr (assoc 2 lay)) lst)) ) (setq blk_name_prefix "Pipe_") ; Change this prefix as needed (setq filepath (getvar "dwgprefix")) ; (foreach layer_name lst (if (/= layer_name "0") ; Exclude layer 0 (progn (setq sel (ssget "x" (list (cons 8 layer_name)))) (if sel (progn (setq blk_name (strcat blk_name_prefix layer_name )) (command "._CLAYER" layer_name) (command "_-Wblock" (strcat filepath blk_name) blk_name "" "0,0,0" sel "") (command "_Xref" "A" (strcat filepath blk_name ".dwg") "0,0,0" "1" "1" "0") ); end of PROGN ); end of IF ) ; end of PROGN ); end of IF ); end foreach ; (princ "\n ") (princ "Blocks created for all layers except layer 0.") ) As you can see I have also changed from creating blocks to Wblocks & xrefs. Just made a coffee while the lsp was run on the first real drawing, 80 layers converted into dwg's & xref in before I'd made the coffee

@ElAmigo this is fairly easy and doesn't necessarily require a LISP routine unless you are trying to incorporate it into you existing routine. If that is the case: (setq ss (ssget "X" '((0 . "DIMENSION")(8 . "LayerY")))) (command "._dimoverride" "DIMCLRT" 2 "" ss "");<--Overrides the dimension text color to make it yellow.

!! GREAT !! THANKS

45 degree angle... In all the codes above there is a list something like this: '(0 5 0), change that so the first 2 numbers are the same: '(5 5 0) and use a negative value to rotate the 45 degree angle line: examples: '(5 5 0) '(5 -5 0) '(-10 -10 00) '(-10 10 00)

It's the start of a fun week. I tried it with the Lisp you uploaded today. Today I discovered another problem. Strangely, there was a phenomenon in which the shape changed even though the line was not selected. There was also a phenomenon where some lines disappeared. I will upload the drawing. Autodesk AutoCAD 2018 - [TEST - (24.02.26).dxf] 2024-02-26 16-31-17.mp4 TEST - (24.02.26).dxf

Try this one, I think it is a bit more reliable... but might not be.. in testing with your sample it was working - for me. Command: L2Arc Select all entities and it should locate arcs and convert lines to arcs. Arc is defined if 3 or more adjacent lines have a similar perpendicular intersection and are a similar line length (defun LM:3pcircle ( pt1 pt2 pt3 / cen md1 md2 vc1 vc2 ) (if (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2) md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3) vc1 (mapcar '- pt2 pt1) vc2 (mapcar '- pt3 pt2) cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0)) md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0)) nil ) ) (list cen (distance cen pt1)) ) ) (defun ConnectedArc ( MyEnt INark / FF LineSS ConnectedLines MyList Pt AnEnt Pt1 Pt2 MyEntLen PtA PtB MySS CLCount IntEnt MidPt MyAng PtC Int1 MyRadius StopLoop Pt3 APtA APtB NewLine Int2 ARadius) ;;returns selection set of lines sharing a common perpendicular line intersection point ;;sort of, includes fuzz factor ;;;;Sub functions (defun DrawLine (pt1 pt2) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) ))) ; draws a line (defun mid-pt ( p1 p2 / ) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) ) ) ; mid point p1 to p2 (defun LM:intersections ( ob1 ob2 mod / lst rtn ) ; Intersection between 2 lines (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;;;;End Sub functions (setq FF 0.002) ; Fuzz factor. Proportion of the lengths (setq ConnectedLines (ssadd MyEnt)) ; List for lines connected to selected entity (setq Pt1 (cdr (assoc 10 (entget MyEnt)))) ; End A point (setq Pt2 (cdr (assoc 11 (entget MyEnt)))) ; End B point (setq PtA Pt1) (setq PtB Pt2) (setq AnEnt MyEnt) (repeat 2 (setq Pt1A (mapcar '+ (list (* FF -1) (* FF -1)) PtA)) ; Small area around end of line (setq Pt1B (mapcar '+ (list (* FF 1) (* FF 1)) PtA)) (setq MySS (ssget "_C" Pt1A Pt1B '((0 . "LINE"))) ) ; select adjacent lines (if (= (sslength MySS) 2) ; Found one adjacent intersection point (progn (setq MySS (ssname (ssdel AnEnt MySS) 0)) ; Next line (if (equal (cdr (assoc 10 (entget MySS))) PtA 0.001) ;find connected end & points (progn (setq APtA (cdr (assoc 10 (entget MySS)))) ; next line end points (setq APtB (cdr (assoc 11 (entget MySS)))) ; next line end points ) (progn (setq APtA (cdr (assoc 11 (entget MySS)))) ; next line end points (setq APtB (cdr (assoc 10 (entget MySS)))) ; next line end points ) ) ; end if connected ends (setq Int1 (car (LM:3pcircle PtA PtB APtB)) ) ;;Intersection (setq MyRadius1 (cadr (LM:3pcircle PtA PtB APtB)) );;Radius ) ; end progn ) ; end if MySS length 2 (setq StopLoop "No") ; Marker to stop looping (while (= StopLoop "No") (setq PtX (mapcar '+ (list (* FF -1) (* FF -1)) PtA)); Small area around end of line (setq PtY (mapcar '+ (list (* FF 1) (* FF 1)) PtA)); Other corner (setq MySS (ssget "_C" PtX PtY '((0 . "LINE"))) ) ; select joining lines (if (= (sslength MySS) 2) ; If only 2 joining lines (progn (setq MySS (ssdel AnEnt MySS)) ; Next line (setq AnEnt (ssname MySS 0)) ; next line entity name (if (or (ssmemb AnEnt ConnectedLines) (ssmemb AnEnt INark) ) (progn (princ "Repeating Selection") (setq StopLoop "Yes") ) (progn (if (equal (cdr (assoc 10 (entget AnEnt))) ptA 0.001) ;find connected end & points (progn (setq APtA (cdr (assoc 10 (entget AnEnt)))) ; next line end points (setq APtB (cdr (assoc 11 (entget AnEnt)))) ; next line end points ) (progn (setq APtA (cdr (assoc 11 (entget AnEnt)))) ; next line end points (setq APtB (cdr (assoc 10 (entget AnEnt)))) ; next line end points ) ) ; end if connected ends (setq Int2 (car (LM:3pcircle PtB APtA APtB) )) (setq MyRadius2 (cadr (LM:3pcircle PtA PtB (if (equal PtA APtA FF) APtB APtA)) )) (if (and (equal Int1 Int2 (* MyRadius1 FF)) (equal (distance Pt1 Pt2) (distance APtA APtB) (* MyRadius1 FF)) ) ; end end (progn (setq ConnectedLines (ssadd AnEnt ConnectedLines)) ; add next line to list ) ; end progn (progn (setq StopLoop "Yes") ) ; end prog ) ; end if intersection match (setq PtA APtB) ) ; end progn ) ; end if connected lines ) ; end progn (progn (setq StopLoop "Yes") ) ; end progn ) ; end if SSlength = 2 ) ; end while stoploop ;;Reset for repeat (setq PtA Pt2) (setq PtB Pt1) (setq AnEnt MyEnt) ) ; end repeat ; (princ "\n")(princ (sslength ConnectedLines))(princ " Connected Lines Found") (list ConnectedLines Int1 MyRadius1 (sslength ConnectedLines)) ; Return Connected Lines ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:l2arc (/ thisdrawing ArcSS ArcLines ArcSSCount MyEnt MyArc MySS MyList p1 p2 p3 acount) ;;sub functions (defun onlyunique ( MyList / returnList n ) (setq ReturnList (list)) ; blank list for result (foreach n MyList ; loop through supplied list (if ( = (member n (cdr (member n MyList))) nil) ; if list item occurs only once (setq ReturnList (append ReturnList (list n))) ; add to list ) ) ; end foreach ReturnList ) (defun uniquepoints ( MySS / MyList acount MyEnt) (princ "Select Lines") (setq MyList (list)) ; Blank list for line coordinates (setq acount 0) (while (< acount (sslength MySS)) ; loop each line (setq MyEnt (entget (ssname MySS acount))) (setq MyList (append MyList (list (cdr (assoc 10 MyEnt))))) ; add end A to list (setq MyList (append MyList (list (cdr (assoc 11 MyEnt))))) ; add end B to list (setq acount (+ acount 1)) ) (list (onlyunique MyList) MyList) ; list: Unique Items, All Items ) (defun 3parc ( pt1 pt2 pt3 / lst ocs pt1 pt2 pt3 ) ; Lee Mac (if (setq ocs (trans '(0 0 1) 1 0 t)) (if (setq lst (LM:3pcircle pt1 pt2 pt3)) (progn (if (minusp (sin (- (angle pt1 pt3) (angle pt1 pt2)))) (mapcar 'set '(pt1 pt3) (list pt3 pt1)) ) (entmakex (list '(000 . "ARC") (cons 010 (trans (car lst) 1 ocs)) (cons 040 (cadr lst)) (cons 050 (angle (trans (car lst) 1 ocs) (trans pt1 1 ocs))) (cons 051 (angle (trans (car lst) 1 ocs) (trans pt3 1 ocs))) (cons 210 ocs) ) ) ) (princ "\nPoints are collinear.") ) ) (princ) ) (defun LM:ss-union ( lst / out ) (setq lst (vl-sort lst '(lambda ( a b ) (> (sslength a) (sslength b)))) out (car lst) ) (foreach ss (cdr lst) (repeat (setq i (sslength ss)) (ssadd (ssname ss (setq i (1- i))) out) ) ) out ) ;;end sub functions ;;'Main' stuff apart from the functions above (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark thisdrawing) ; Start Undo (setq ArcSS (ssget '((0 . "LINE")))) ; Selection Set (setq ArcLines (ssadd)) ; List for lines contained in an arc (setq ArcSSCount 0) ; A counter (while (< ArcSSCount (sslength ArcSS)) ; while loop (setq MyEnt (ssname ArcSS ArcSSCount)); Next entity in loop (if (ssmemb MyEnt ArcLines) ; If entity is in an arc.... (progn ; do nothing ) (progn (setq MyArc (ConnectedArc MyEnt ArcLines)) ; Find all lines connected that are in an arc (setq MySS (car MyArc)) ; Entities that make arc (if (or (= MySS nil) (> 3 (sslength MySS)) ; If more than 3 entities its an arc. Can change 3 to suit ) ; end or (progn ; not an arc ) (progn (setq MyList (uniquepoints MySS)) ; car: unique points, cadr: points list (setq ArcLines (LM:ss-union (list ArcLines MySS))) ; add entities to ignore list (setq p1 (car (car MyList))) ; first unique point (setq p2 (nth (/ (length (cadr MyList)) 2) (cadr MyList))) ; point within the arc (setq p3 (cadr (car MyList))) ; second unique point (3parc p1 p2 p3) ; draw arc ) ; end progn ) ; end if arc returned ) ; end progn ) ; end if entity in an arc (setq ArcSSCount (+ ArcSSCount 1) ) ; Increase count ) ; end while (setq acount 0) (repeat (sslength ArcLines) ; delete arc lines. Use entdel to keep command line quiet (entdel (ssname ArcLines acount)) (setq acount (+ acount 1)) ) (vla-endundomark thisdrawing) ; end undo (princ) )

Sorry for the late reply... try this one, and change the top line file path to your actual file path of the sample that you sent: (setq *Excel_File_Path* "C:\\Users\\your_excel_file\\Downloads\\a.xlsx") (defun c:testexcel ( / *error* activeundo acadobj adoc pck adoc excel_app excel_sht excel_wb pck) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if pck (setvar "PICKADD" pck)) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) ) (setq pck (getvar "PICKADD")) (setvar "PICKADD" 2) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (setq excel_app (vlax-get-or-create-object "Excel.Application") excel_wb (vlax-invoke (Excel:GetProperty excel_app '("Workbooks")) "Open" *Excel_File_Path*) excel_sht (Excel:GetProperty excel_wb '("Sheets" ("Item" 1))) ) (vlax-put-property excel_app "Visible" :vlax-true) (princ (strcat "\nCell Address: " (Excel:GetProperty (Excel:FindTest excel_sht "a" "A" "B") '(("Address" :vlax-false :vlax-false 1)) ) ) ) (setvar "PICKADD" pck) (if (not activeundo) (vla-EndUndoMark adoc)) (princ) ) (defun Excel:FindTest (sheet search search_column return_column / column_number find_cell) (setq column_number (Excel:GetProperty sheet (list (list "Range" (strcat return_column "1")) "Column"))) (if (setq find_cell (vlax-invoke (Excel:GetProperty sheet (list (list "Range" (strcat search_column ":" search_column)) ) ) "Find" search nil nil 1 ;; <-- 1 as xlWhole ) ) (Excel:GetProperty sheet (list "Cells" (list "Item" (Excel:GetProperty find_cell '("Row")) column_number) ) ) ) ) (defun Excel:GetProperty (vla lst) (foreach x lst (if (listp x) (setq vla (apply 'vlax-get-property (cons vla x))) (setq vla (apply 'vlax-get-property (list vla x))) ) (if (eq (type vla) 'variant) (setq vla (vlax-variant-value vla))) ) vla ) (vl-load-com)

and a little shorter code... Sunday night and time to sit for 20 minutes. Swap it around for vertical mirror (defun c:hmirror ( / ) ;; Comments as above (command "Mirror" (ssget) "" (getpoint "\nSelect Mirror Axis Point: ") (mapcar '+ '(5 0 0) (getvar 'lastpoint)) Pause) )

The wow works with your latest dwg, ok for the dbl reverse curves select not quite a full 90 degree of lines for both arcs, then draw a line using osnap Center then extend the arcs to that line, you want to zoom in where the 2 arcs join I did find a tiny error so moved 1 arc end point. The other thing I noticed is for the dbl in some cases where the 2 radius where maybe meant to be the same I get a slight variation in the 2 arc radius.

I noticed that yesterday but didn't have time to look into what wasn't working quite right - one of those frustrating intermittent things I think - I'll see if I can get chance to look again and see what I did wrong. Nearly there though for what I want it to be

(c:foam) this implies run the function on loading, if you want to run again just type FOAM on the command line. I just write a lot of my code once it is loaded, run it, knowing may need to run again, so no need to load each time

What you posted only makes a selection set of Regions and then runs something else with that selection set. Might have been part of a bigger lisp. yep you need the lisp from the first post. looks like that does alot more stuff then what i posted and has error handling. ;;----------------------------------------------------------------------;; ; Region To Polyline (defun C:R2P (/ SS LastEnt en) (if (setq ss (ssget "_x" '((0 . "REGION")))) (progn (setq LastEnt (entlast)) (vl-cmdf "_.Explode" SS) (if (setq en (entnext LastEnt)) (while en (ssadd en SS) (setq en (entnext en)) ) ) (vl-cmdf "_.Join" SS "") ;(sssetfirst nil SS) ;uncomment if you want them selected after lisp ends ) (princ "No Regions in the Drawing") ) (princ) ) --edit-- forgot the princ

I'm writing ... unfortunately slowly because I have little time available. @ReMark: Thanks. An example of using, the hatch is adapted to the destination curves and transformed into block.