Nice job Tharwat!
(defun time-it ( expr / et st )
(setq st (getvar 'millisecs))
(eval expr)
(setq et (getvar 'millisecs))
(princ (strcat "\nProgram running time: " (itoa (- et st)) " msecs."))
(princ)
)
(time-it '(c:test))
Here is a short & simple timing function so that we may compare challenge entries :-)Thanks Lee. I was just going to ask ... :)
I think I'd be too arrogant to cosider myself an experienced coder
[CommandMethod("SHOLON")]
public void cmd_shortestLongestLines()
{
var e = AcadApp.DocumentManager.MdiActiveDocument.Editor;
TypedValue[] tv = { new TypedValue((int)DxfCode.Start, "LINE") };
var filter = new SelectionFilter(tv);
var options = new PromptSelectionOptions
{
MessageForAdding = "\nAdd lines to selection",
MessageForRemoval = "\nRemove lines from selection",
AllowDuplicates = false,
RejectObjectsFromNonCurrentSpace = true
};
var psr = e.GetSelection(options, filter);
if (psr.Status != PromptStatus.OK) return;
var sw = new Stopwatch();
var pairs = new SortedList<double, ObjectId>();
using (var tr = e.Document.Database.TransactionManager.StartTransaction())
{
sw.Start();
foreach (var id in psr.Value.GetObjectIds())
{
var line = tr.GetObject(id, OpenMode.ForRead) as Line;
if (line != null)
{
pairs.Add(line.Length, id);
}
}
pairs.RemoveAt(0);
pairs.RemoveAt(pairs.Count - 1);
foreach (var pair in pairs)
{
tr.GetObject(pair.Value, OpenMode.ForWrite).Erase();
}
sw.Stop();
tr.Commit();
}
e.WriteMessage("\nElapsed.TotalMilliseconds={0} \n", sw.Elapsed.TotalMilliseconds);
}
Elapsed.TotalMilliseconds=1320.1172I think I'd be too arrogant to cosider myself an experienced coder
...
Very good solution using an 'unerase'
(defun c:KRU (/ res)
(ssget "_x" '((0 . "LINE")))
(vlax-for %
(vla-get-activeselectionset
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq res (cons (list (vla-get-length %) %) res))
(if (> (length res) 2)
(progn
(setq res
(vl-sort res
(function
(lambda (%1 %2)
(< (car %1) (car %2))
)
)
)
)
(vla-delete (cadadr res))
(setq res (list (car res) (last res)))
)
)
)
(list
(cons (caar res) (vla-get-layer (cadar res)))
(cons (caadr res) (vla-get-layer (cadadr res)))
)
)
((19.6269 . "CYAN") (1528.89 . "GREEN"))
TIME-IT
((BLUE 20.1582 1442.59 <Entity name: 7d3ad5e8>) (CYAN 19.6269 1468.04 <Entity name: 7d3b2240>) (GREEN 20.9117 1528.89 <Entity name: 7d3a07b0>) (RED 20.5474 1504.13 <Entity name: 7d3a5ba8>))
Program running time: 702 msecs.
Great challenge Mark.
Thanks for the timer Lee.Code: [Select]TIME-IT
((BLUE 20.1582 1442.59 <Entity name: 7d3ad5e8>) (CYAN 19.6269 1468.04 <Entity name: 7d3b2240>) (GREEN 20.9117 1528.89 <Entity name: 7d3a07b0>) (RED 20.5474 1504.13 <Entity name: 7d3a5ba8>))
Program running time: 702 msecs.
(defun time-it ( expr msg / et st )
(setq st (getvar 'millisecs))
(eval expr)
(setq et (getvar 'millisecs))
(princ (strcat msg (itoa (- et st)) " msecs."))
(princ)
)
(defun dst (p1 p2 / v)
(setq v (mapcar '- p2 p1))
(sqrt (+ (expt (car v) 2) (expt (cadr v) 2) (expt (caddr v) 2)))
)
(defun makelst ( / k l1 l2 )
(setq k 0.0)
(repeat 20000
(setq l1 (append l1 (setq l1 (list (1+ k)))))
)
(setq l2 (reverse l1))
(setq ptlst (mapcar '(lambda (a b c) (list a b c)) l1 l1 l2))
)
(defun testdst ( ptlst )
(mapcar '(lambda (a b) (dst a b)) ptlst (cdr ptlst))
)
(defun testdistance ( ptlst )
(mapcar '(lambda (a b) (distance a b)) ptlst (cdr ptlst))
)
(defun c:test-times ( / ptlst )
(makelst)
(time-it '(testdst ptlst) "\n\"Dst\" function running time: ")
(time-it '(testdistance ptlst) "\n\"Distance\" LISP function running time: ")
(textscr)
(princ)
)
(defun C:TEST ( / acDoc cm)
(setq cm (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(foreach fun '((ph:byLayer) (ph:all1) (ph:all2))
(vla-StartUndoMark acDoc)
(gc)
(time-it fun)
(vla-EndUndoMark acDoc)
(command "U")
)
(setvar 'cmdecho cm)
(textscr)
(princ)
)
(defun time-it ( expr / et st )
(setq st (getvar 'millisecs))
(eval expr)
(setq et (getvar 'millisecs))
(princ (strcat "\nProgram running time: " (vl-princ-to-string expr) " - " (itoa (- et st)) " msecs."))
(princ)
)
And resultsCommand: TEST
("CYAN" 19.6269 1468.04)
("RED" 20.5474 1504.13)
("BLUE" 20.1582 1442.59)
("GREEN" 20.9117 1528.89)
Program running time: (PH:BYLAYER) - 765 msecs.
(19.6269 1528.89)
Program running time: (PH:ALL1) - 625 msecs.
(19.6269 1528.89)
Program running time: (PH:ALL2) - 672 msecs.
Command: TEST
("CYAN" 19.6269 1468.04)
("RED" 20.5474 1504.13)
("BLUE" 20.1582 1442.59)
("GREEN" 20.9117 1528.89)
Program running time: (PH:BYLAYER) - 875 msecs.
(19.6269 1528.89)
Program running time: (PH:ALL1) - 547 msecs.
(19.6269 1528.89)
Program running time: (PH:ALL2) - 563 msecs.
Command: TEST
("CYAN" 19.6269 1468.04)
("RED" 20.5474 1504.13)
("BLUE" 20.1582 1442.59)
("GREEN" 20.9117 1528.89)
Program running time: (PH:BYLAYER) - 875 msecs.
(19.6269 1528.89)
Program running time: (PH:ALL1) - 531 msecs.
(19.6269 1528.89)
Program running time: (PH:ALL2) - 562 msecs.
I've run the test several times with contradictory results. For example, for the first function the running time was in range 703... 1265 ms.Very good solution using an 'unerase'x2 :)
Very good solution using an 'unerase'x2 :)
(defun LM:shortlong ( / _max _min d e i l r s )
(if (setq s (ssget "_X" '((0 . "LINE"))))
(progn
(setq _min 1e308
_max 0.0
)
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i)))
l (entget e)
d (distance (cdr (assoc 10 l)) (cdr (assoc 11 l)))
)
(if (< _min d _max)
(entdel e)
(progn
(if (< d _min) (setq _min d))
(if (< _max d) (setq _max d))
(setq r (cons (list d e) r))
)
)
)
(foreach x r
(or (equal (car x) _min 1e-8)
(equal (car x) _max 1e-8)
(entdel (cadr x))
)
)
)
)
(list _min _max)
)
(defun LM:shortlong2 ( / _max _min d e i l m n r s )
(if (setq s (ssget "_X" '((0 . "LINE"))))
(progn
(setq _min 1e308
_max 0.0
)
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i)))
l (entget e)
d (distance (cdr (assoc 10 l)) (cdr (assoc 11 l)))
)
(if (< d _min) (setq _min d m e))
(if (< _max d) (setq _max d n e))
(entdel e)
)
(entdel m)
(entdel n)
)
)
(list _min _max)
)
(LM:SHORTLONG2) running time: 1732 msecs.
(LM:SHORTLONG) running time: 1779 msecs.
(PH:MINMAXLINE) running time: 1857 msecs.
(C:KRU) running time: 8487 msecs.
(THARWAT:TEST) running time: 11061 msecs.
(PH:ALL1) running time: 702 msecs.
(LM:SHORTLONG) running time: 1809 msecs.
(LM:SHORTLONG2) running time: 1872 msecs.
(PH:MINMAXLINE) running time: 1950 msecs.
(C:KRU) running time: 8767 msecs.
(THARWAT:TEST) running time: 9999 msecs.
c:shortlongest by Marc'Antonio Alessi didn't return the correct result, so I didn't compare it.
(PH:ALL1) running time: 686 msecs.
(C:SHORTLONGEST) running time: 1311 msecs.
(C:TEST3) Program running time: 2140 msecs.
(("RED" <Entity name: 7f62825c520> <Entity name: 7f628264750>)
("GREEN" <Entity name: 7f6292e9210> <Entity name: 7f628207f60>)
("CYAN" <Entity name: 7f62eaf6480> <Entity name: 7f62eade230>)
("BLUE" <Entity name: 7f62770cbd0> <Entity name: 7f62b641330>)
)
With undo turned off, I get:Code: [Select](PH:ALL1) running time: 686 msecs.
(C:SHORTLONGEST) running time: 1311 msecs.
I found during my tests that if I did many tests in quick succession, they became increasingly slower, what once took a mere 1800ms was taking over 60000ms and it got progressively 30-50% slower with each run .. until I closed the drawing and reopened it.Yes, is better to reopen DWG.
Wow you'll have busy this morning. :-)
[CommandMethod("SHOLON")]
public void cmd_shortestLongestLines()
{
var e = AcadApp.DocumentManager.MdiActiveDocument.Editor;
TypedValue[] tv = { new TypedValue((int)DxfCode.Start, "LINE") };
var filter = new SelectionFilter(tv);
var options = new PromptSelectionOptions
{
MessageForAdding = "\nAdd lines to selection",
MessageForRemoval = "\nRemove lines from selection",
AllowDuplicates = false,
RejectObjectsFromNonCurrentSpace = true
};
var psr = e.GetSelection(options, filter);
if (psr.Status != PromptStatus.OK) return;
var sw = new Stopwatch();
var pairs = new SortedList<double, Line>();
using (var tr = e.Document.Database.TransactionManager.StartTransaction())
{
sw.Start();
foreach (var id in psr.Value.GetObjectIds())
{
var line = tr.GetObject(id, OpenMode.ForRead) as Line;
if (line != null)
{
pairs.Add(line.Length, line);
}
}
pairs.RemoveAt(0);
pairs.RemoveAt(pairs.Count - 1);
foreach (var pair in pairs)
{
pair.Value.UpgradeOpen();
pair.Value.Erase();
//tr.GetObject(pair.Value, OpenMode.ForWrite).Erase();
}
sw.Stop();
tr.Commit();
}
e.WriteMessage("\nElapsed.TotalMilliseconds={0} \n", sw.Elapsed.TotalMilliseconds);
}
Command: sholon
Add lines to selection: Specify opposite corner: 38608 found
Add lines to selection:
Elapsed=364msecs short19.6269346852711long1528.88882854822
[CommandMethod("SHOLON")]
public void cmd_shortestLongestLines()
{
var e = AcadApp.DocumentManager.MdiActiveDocument.Editor;
TypedValue[] tv = { new TypedValue((int)DxfCode.Start, "LINE") };
var filter = new SelectionFilter(tv);
var options = new PromptSelectionOptions
{
MessageForAdding = "\nAdd lines to selection",
MessageForRemoval = "\nRemove lines from selection",
AllowDuplicates = false,
RejectObjectsFromNonCurrentSpace = true
};
var psr = e.GetSelection(options, filter);
if (psr.Status != PromptStatus.OK) return;
var sw = new Stopwatch();
var pairs = new Dictionary<double, Line>();
KeyValuePair<double, Line> longestLine;
KeyValuePair<double, Line> shortestLine;
using (var tr = e.Document.Database.TransactionManager.StartTransaction())
{
sw.Start();
foreach (var id in psr.Value.GetObjectIds())
{
var line = tr.GetObject(id, OpenMode.ForWrite) as Line;
pairs.Add(line.Length, line);
line.Erase();
}
longestLine = pairs.Aggregate((a, b) => b.Key > a.Key ? b : a);
shortestLine = pairs.Aggregate((a, b) => b.Key < a.Key ? b : a);
longestLine.Value.Erase(false);
shortestLine.Value.Erase(false);
sw.Stop();
tr.Commit();
}
e.WriteMessage("\nElapsed={0}msecs short{1}long{2} \n", sw.ElapsedMilliseconds,
shortestLine.Key.ToString(CultureInfo.InvariantCulture), longestLine.Key.ToString(CultureInfo.InvariantCulture));
}
Bravo Stefan! :-)
weird, I also tried the newly opened dwg...
Comando: _U
Comando A disattivato. Utilizzare il comando ANNULLA per attivarlo
Comando: (time-it '(ph:all1)) Program running time: 4181 msecs.
Comando: (time-it '(c:ShortLongest))Program running time: 2745 msecs.
(LM:SHORTLONG) running time = 1232
(LM:SHORTLONG2) running time = 1248
(THARWAT) running time = 11981
(PH:ALL1) running time = 20046
vlax-curve works awful slow on i5 or is something wrong with that computer. If someone had the same results, please let me know.vlax-curve works awful slow on i5 or is something wrong with that computer.
(PH:ALL1) running time = 390
Weird for me too...
I've made all tests on this: Pentium Dual Core, 3.0 GHz, 2Gb Ram, Autocad 11, 32bit
Then I tried on this configuration: Intel i5 ( x64), 4Gb Ram, Autocad 2012, 64bitCode: [Select](LM:SHORTLONG) running time = 1232
vlax-curve works awful slow on i5 or is something wrong with that computer. If someone had the same results, please let me know.
(LM:SHORTLONG2) running time = 1248
(THARWAT) running time = 11981
(PH:ALL1) running time = 20046
Using Win7 64Quote(PH:ALL1) running time = 390
(defun c:Long&ShortOfIt ( / dx ls ss i e l_ s_)
(defun dx (d x)(cdr (assoc d (entget x))))
(defun Ls (m y)(list (assoc (apply m (mapcar 'car y)) y)))
(if (setq ss (ssget "_x" '((0 . "LINE"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
l_ (cons (list (distance (dx 10 e )(dx 11 e)) e) l_)
s_ (cons (car l_) s_))
(setq l_ (ls 'max l_)
s_ (ls 'min s_))
)
(command "_erase" ss "")
(entdel (cadr (car l_)))
(entdel (cadr (car s_)))
)
)(princ)
)
(defun c:Long&ShortOfItnc ( / dx ls ss i e l_ s_)
(defun dx (d x)(cdr (assoc d (entget x))))
(defun Ls (m y)(list (assoc (apply m (mapcar 'car y)) y)))
(if (setq ss (ssget "_x" '((0 . "LINE"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
l_ (cons (list (distance (dx 10 e )(dx 11 e)) e) l_)
s_ (cons (car l_) s_))
(setq l_ (ls 'max l_)
s_ (ls 'min s_))
(entdel e)
)
(entdel (cadr (car l_)))
(entdel (cadr (car s_)))
)
)(princ)
)
Try running that on this specsIntel Core2Duo P7450 2.13GHz 4Gb Ram - Seven 64
Memory 1.00 GB
Intel Atom (TM) CPU N455 @1.66GHz
OS: Windows 7 Starter
CAD Version: Autocad 2009
I bet you wouldnt like what you see ;D
AutoCAD 2013
;(time-it '(c:ShortLongest)) Program running time: 3822 msecs.
;(time-it '(ph:all1)) Program running time: 5024 msecs.
;(time-it '(c:Long&ShortOfIt)) Program running time: 7644 msecs.
AutoCAD 2010
;(time-it '(c:ShortLongest)) Program running time: 2028 msecs.
;(time-it '(ph:all1)) Program running time: 67174 msecs. <<< ?
;(time-it '(c:Long&ShortOfIt)) Program running time: 5304 msecs
;AutoCAD 2010
;(time-it '(c:CAB:test)) Program running time: 2621 msecs.
;(time-it '(c:ShortLongestByLyr2)) Program running time: 1747 msecs.