Didn't you have the same question just recently? If using the vlax-curve-* functions it would work the same (or at least very similar) to the method for finding the longest & shortest lines.
Didn't you have the same question just recently? If using the vlax-curve-* functions it would work the same (or at least very similar) to the method for finding the longest & shortest lines.
My apologies for my english, is it a question for me? If so please can you give me an example?
Marco
I think irneb indicating to the following thread . :-D
http://www.theswamp.org/index.php?topic=43714.0 (http://www.theswamp.org/index.php?topic=43714.0)
Didn't you have the same question just recently?The only difference in this challenge is the .dwg contains 3D Plines.
The only difference in this challenge is the .dwg contains 3D Plines.Fine I assumed it's something like that. Thus you'd want this to be a case of adding polyline segment lengths together.
Try doing it without vlax-*.
_$ (DoTest '((c:RemAllButLongest&Shortest)))
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 1030 msecs.
_$ (DoTest '((c:RemAllButLongest&Shortest) (c:RemAllButLongest&Shortest1)))
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 1045 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 93 msecs.
BTW, I've used Lee's time-it function in a combined version, so I am assured of "equal" allowance for each version:_$ (DoTest '((c:RemAllButLongest&Shortest1) (c:RemAllButLongest&Shortest)))
(C:REMALLBUTLONGEST&SHORTEST1)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 1077 msecs.
_$ (DoTest '((c:RemAllButLongest&Shortest1) (c:RemAllButLongest&Shortest) (C:ShortLongestPL) (C:ShortLongestPLByLyr) (c:RemAllButLongest&ShortestByLayer)))
(C:REMALLBUTLONGEST&SHORTEST1)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 63 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 967 msecs.
(C:SHORTLONGESTPL) Program running time: 125 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 141 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 47 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 983 msecs.
(C:SHORTLONGESTPL) Program running time: 125 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 141 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 47 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 47 msecs.
I think I know why this version is faster, is there anyone who knows?
C:REMALLBUTLONGEST&SHORTESTBYLAYER
Program running time: 78 msecs.
Empirically it doesn't appear to be the answer. Your previous code was faster:I think I know why this version is faster, is there anyone who knows?
This is the answer:
(C:ALE_SHORTLONGESTPL) Program running time: 297 msecs.
(C:TESTFOO) Program running time: 218 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 140 msecs.
(C:SHORTLONGESTPL) Program running time: 140 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 63 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 1107 msecs.
I think mine using the vlax-curve functions should perform faster due to it never needing to entget or convert the ename to a vla-object. The entget route is obviously extremely slow since it gets all the data from each entity (including each vector). The vla method should be a lot quicker since it obtains the full length by only one method. But the vlax-curve method goes quicker since it's not converting the eename at all (and from previous tests it's faster working directly on enames than on vla-objects).(C:ALE_SHORTLONGESTPL) Program running time: 187 msecs.
(C:TESTFOO) Program running time: 203 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 141 msecs.
(C:SHORTLONGESTPL) Program running time: 140 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 63 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER1) Program running time: 156 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest : Layer=RED; Length =71652.0653
Shortest: Layer=RED; Length =243.2759
Program running time: 1139 msecs.
(defun c:test(/ doc ent lst sel tab tmp)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(and (ssget "x" (list (cons 0 "*POLYLINE")))
(progn
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq lst (cons (list (vla-get-layer ent) (vla-get-length ent) ent) lst))
)
(vla-delete sel)
(while lst
(setq tmp (vl-sort (vl-remove-if-not '(lambda(x) (eq (caar lst) (car x))) lst) '(lambda(a b)(< (cadr a) (cadr b))))
tab (cons (append (car tmp) (last tmp)) tab)
tmp (cdr (vl-remove (last tmp) tmp))
lst (vl-remove-if '(lambda(x) (eq (caar lst) (car x))) lst)
)
(mapcar '(lambda(x)(vla-delete (caddr x))) tmp)
)
)
)
(princ tab)
(vla-endundomark doc)
(princ)
)
Empirically it doesn't appear to be the answer. Your previous code was faster:inerb,
<clip>
_$ (time-it '(C:ALE_ShortLongestPL))
Program running time: 188 msecs.
_$ (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 94 msecs.
I'm running in ACA 2013 in vanilla mode.Command: (load "G:\\Documents\\AutoLisp Tests\\Longest Shortest Line\\LongShort.LSP")
C:REMALLBUTLONGEST&SHORTESTBYLAYER1
Command: (time-it '(C:ALE_ShortLongestPL))
...
Program running time: 140 msecs.
Command: (load "G:\\Documents\\AutoLisp Tests\\Longest Shortest Line\\LongShort.LSP")
C:REMALLBUTLONGEST&SHORTESTBYLAYER1
Command: (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 78 msecs.
(defun c:RemAllButLongest&ShortestByLayerLeeMacMod ( / en in le ll ln se sl ss )
(foreach la '((8 . "BLUE") (8 . "CYAN") (8 . "GREEN") (8 . "RED"))
(setq ll -1.0 le nil
sl 1e308 se nil
)
(if (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") la)))
(progn
(repeat (setq in (sslength ss))
(setq en (ssname ss (setq in (1- in)))
ln (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
)
(if (< ll ln)
(setq ll ln le en)
)
(if (< ln sl)
(setq sl ln se en)
)
(entdel en)
)
(entdel le)
(entdel se)
)
)
)
(princ)
)
OK, don't know what's the issue on yours. I've done the test by closing ACad down fully, then opening that DWG again, loading & running one of the codes from VLIDE, then closing acad. Then re-open acad and the DWG and rerun the test on the next. These are the results I get:Also test in Vlide, now I think test are very unreliable:Code: [Select]_$ (time-it '(C:ALE_ShortLongestPL))
I'm running in ACA 2013 in vanilla mode.
Program running time: 188 msecs.
_$ (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 94 msecs.
Could the following modifications perhaps shave off a few millisecs?Code: [Select](defun c:RemAllButLongest&ShortestByLayerLeeMacMod ( / en in le ll ln se sl ss )
(foreach la '((8 . "BLUE") (8 . "CYAN") (8 . "GREEN") (8 . "RED"))
(setq ll -1.0 le nil
sl 1e308 se nil
)
(if (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") la)))
(progn
(repeat (setq in (sslength ss))
(setq en (ssname ss (setq in (1- in)))
ln (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
)
(if (< ll ln)
(setq ll ln le en)
)
(if (< ln sl)
(setq sl ln se en)
)
(entdel en)
)
(entdel le)
(entdel se)
)
)
)
(princ)
)
Could the following modifications perhaps shave off a few millisecs?(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs. :-)Code: [Select](defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >
Could the following modifications perhaps shave off a few millisecs?(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs. :-)Code: [Select](defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >
Your computer is way faster than mine :-D
Could the following modifications perhaps shave off a few millisecs?(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs. :-)Code: [Select](defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >
Your computer is way faster than mine :-D
What was your time?
Command: netload
Command: sp2
Add polylines to selection: Specify opposite corner: 1624 found
Add polylines to selection:
Elapsed=88msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 109 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) Program running time: 109 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER1) Program running time: 359 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 405 msecs.
(C:TESTFOO) Program running time: 499 msecs.
(C:PATRICK_35TEST) Program running time: 546 msecs.
(C:ALE_SHORTLONGESTPLBYLYR01) Program running time: 561 msecs.
the best performance, i was able to get using a c# routine is 88msecs on a bylayer sorting
the best performance, i was able to get using a c# routine is 88msecs on a bylayer sorting
But how fast do the AutoLISP solutions run on your system by comparison?
Here are my results for all 'layer-by-layer' programs posted: ...
Here are my results for all 'layer-by-layer' programs posted: ...What AutoCAD version?
Command: (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 125 msecs.
Command: (time-it '(C:ALE_ShortLongestPLByLyr01))
_.ERASE
Select objects: _ALL 1624 found
Select objects: _R
Remove objects: 8 found, 8 removed, 1616 total
Remove objects:
Command:
Program running time: 375 msecs.
Command: (time-it '(c:testfoo))
Program running time: 157 msecs.
ps> guess it is taking me more time to remove all those stupid numbers on the code rows.... can't do any more testing, it is a lot of waste of time to remove all those numbers on the rows (maybe there is a shortcut to remove them easily... but still no idea why they are needed?)
if possible, please remove those or post code using just the code /code with the brackets... that's much better - my 2cts.
I do not have 2013 on Win 32-bit, can you test this:Here are my results for all 'layer-by-layer' programs posted: ...What AutoCAD version?
AutoCAD 2013 / Windows 7 Ultimate 32-bit
Intel Core2 Duo 2.1GHz, 3GB RAM
(defun C:ALE_ShortLongestPLByLyr02 ( / SelSet EntDat Countr EntNam LenVal LyrNam InfLtC InfLtB InfLtG InfLtR)
(if (setq SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
(progn
(acad-push-dbmod) (setvar "HIGHLIGHT" 0)
(setq
Countr 0
EntNam (ssname SelSet 0)
EntDat (entget EntNam)
LenVal (vlax-curve-getDistAtParam EntNam (vlax-curve-getEndParam EntNam))
InfLtB (list EntNam LenVal EntNam LenVal)
InfLtC InfLtB InfLtG InfLtB InfLtR InfLtB
)
(repeat (sslength SelSet)
(setq
EntNam (ssname SelSet Countr) EntDat (entget EntNam)
LenVal (vlax-curve-getDistAtParam EntNam (vlax-curve-getEndParam EntNam))
LyrNam (cdr (assoc 8 EntDat))
Countr (1+ Countr)
)
(cond
( (eq LyrNam "BLUE")
(cond
( (> LenVal (cadddr InfLtB))
(setq InfLtB (list (car InfLtB) (cadr InfLtB) EntNam LenVal))
)
( (< LenVal (cadr InfLtB))
(setq InfLtB (list EntNam LenVal (caddr InfLtB) (cadddr InfLtB)))
)
)
)
( (eq LyrNam "CYAN")
(cond
( (> LenVal (cadddr InfLtC))
(setq InfLtC (list (car InfLtC) (cadr InfLtC) EntNam LenVal))
)
( (< LenVal (cadr InfLtC))
(setq InfLtC (list EntNam LenVal (caddr InfLtC) (cadddr InfLtC)))
)
)
)
( (eq LyrNam "GREEN")
(cond
( (> LenVal (cadddr InfLtG))
(setq InfLtG (list (car InfLtG) (cadr InfLtG) EntNam LenVal))
)
( (< LenVal (cadr InfLtG))
(setq InfLtG (list EntNam LenVal (caddr InfLtG) (cadddr InfLtG)))
)
)
)
( (eq LyrNam "RED")
(cond
( (> LenVal (cadddr InfLtR))
(setq InfLtR (list (car InfLtR) (cadr InfLtR) EntNam LenVal))
)
( (< LenVal (cadr InfLtR))
(setq InfLtR (list EntNam LenVal (caddr InfLtR) (cadddr InfLtR)))
)
)
)
)
)
)
)
(command "_.ERASE" SelSet "")
(foreach ForElm (list InfLtC InfLtB InfLtG InfLtR)
(entdel (car ForElm)) (entdel (caddr ForElm))
)
)
ps> guess it is taking me more time to remove all those stupid numbers on the code rows.... can't do any more testing, it is a lot of waste of time to remove all those numbers on the rows (maybe there is a shortcut to remove them easily... but still no idea why they are needed?)
if possible, please remove those or post code using just the code /code with the brackets... that's much better - my 2cts.
Luis, I believe the line numbers are only copied with IE, they aren't copied for me using FF18.0.2...
... test this: ...Maybe with command-s is a little bit faster:
if possible, please remove those or post code using just the code /code with the brackets... that's much better - my 2cts.The numbers don't copy with any other browser but IE (not FF/Chrome/Opera).
My times vary.Could the following modifications perhaps shave off a few millisecs?(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs. :-)Code: [Select](defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >
Your computer is way faster than mine :-D
What was your time?
Command: (time-it '(c:RemAllButLongest&ShortestByLayerLeeMacMod))
Program running time: 46 msecs.
Command: _.undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: 1
Everything has been undone
Command: (time-it '(c:RemAllButLongest&ShortestByLayerLeeMacMod))
Program running time: 31 msecs.
......
A trick you can do if you're stuck using IE (IMO the worst browser there is - this being one of the reasons): click the quote button, then select & copy the code from the edit box. That should remove the numbers.
(defun C:ALE_ShortLongestPLByLyr03 ( / SelSet EntDat Countr EntNam LenVal LyrNam TmpLst InfLst)
(if (setq Countr 0 SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
(progn
(setvar "HIGHLIGHT" 0)
(repeat (sslength SelSet)
(setq
EntNam (ssname SelSet Countr) EntDat (entget EntNam)
LenVal (vlax-curve-getDistAtParam EntNam (vlax-curve-getEndParam EntNam))
LyrNam (cdr (assoc 8 EntDat))
Countr (1+ Countr)
)
(cond
( (not (setq TmpLst (assoc LyrNam InfLst)))
(setq InfLst (cons (list LyrNam EntNam LenVal EntNam LenVal) InfLst))
)
( (> LenVal (nth 4 TmpLst))
(setq InfLst (subst (list (car TmpLst) (cadr TmpLst) (caddr TmpLst) EntNam LenVal) TmpLst InfLst))
)
( (< LenVal (caddr TmpLst))
(setq InfLst (subst (list (car TmpLst) EntNam LenVal (cadddr TmpLst) (nth 4 TmpLst)) TmpLst InfLst))
)
)
)
)
)
(command "_.ERASE" SelSet "")
(foreach ForElm InfLst (entdel (cadr ForElm)) (entdel (cadddr ForElm)))
)
But :| we're all actually missing Mark's request from post #7: Not using any vlax methods.
(defun LM:LongShortPoly ( / e1 e2 el in le ll ln p1 p2 se sl ss )
(foreach la '((8 . "BLUE") (8 . "CYAN") (8 . "GREEN") (8 . "RED"))
(setq ll -1.0 le nil
sl 1e308 se nil
)
(if (setq ss (ssget "_X" (list '(0 . "POLYLINE") la)))
(progn
(repeat (setq in (sslength ss))
(setq e1 (ssname ss (setq in (1- in)))
e2 (entnext e1)
p1 (cdr (assoc 10 (entget e2)))
e2 (entnext e2)
el (entget e2)
ln 0.0
)
(while (= "VERTEX" (cdr (assoc 0 el)))
(setq p2 (cdr (assoc 10 el))
ln (+ ln (distance p1 p2))
e2 (entnext e2)
el (entget e2)
p1 p2
)
)
(if (< ll ln)
(setq ll ln le e1)
)
(if (< ln sl)
(setq sl ln se e1)
)
(entdel e1)
)
(entdel le)
(entdel se)
)
)
)
(princ)
)
(time-it '(LM:LongShortPoly))
Program running time: 2324 msecs.
I'm not too sure which would be faster:IMHO vla-Erase a vla selection set is slower.<clip>
- sending a selection set to the erase command
- entdel each entity in turn
- vla-Delete each entity
- vla-Erase a vla selection set (probably this one, but then the rest of the code doesn't perform too well)
;no vlax-curve-...
(defun C:ALE_ShortLongestPLByLyr05 ( / VlaObj SelSet EntDat Countr EntNam LenVal LyrNam TmpLst InfLst)
(if (setq Countr 0 SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
(progn
(setvar "HIGHLIGHT" 0)
(repeat (sslength SelSet)
(setq
EntNam (ssname SelSet Countr) EntDat (entget EntNam)
VlaObj (vlax-ename->vla-object EntNam)
LenVal (vla-get-length VlaObj)
LyrNam (cdr (assoc 8 EntDat))
Countr (1+ Countr)
)
(cond
( (not (setq TmpLst (assoc LyrNam InfLst)))
(setq InfLst (cons (list LyrNam EntNam LenVal EntNam LenVal) InfLst))
)
( (> LenVal (nth 4 TmpLst))
(setq InfLst (subst (list (car TmpLst) (cadr TmpLst) (caddr TmpLst) EntNam LenVal) TmpLst InfLst))
)
( (< LenVal (caddr TmpLst))
(setq InfLst (subst (list (car TmpLst) EntNam LenVal (cadddr TmpLst) (nth 4 TmpLst)) TmpLst InfLst))
)
)
)
)
)
(command "_.ERASE" SelSet "")
(foreach ForElm InfLst (entdel (cadr ForElm)) (entdel (cadddr ForElm)))
)
(repeat 10
(time-it '(C:ALE_ShortLongestPLByLyr05))
(command "_.OOPS")
(gc)
)
Program running time: 936 msecs.Command: slp
Elapsed=68msecs. 79msecs // here it is returning also the timing using the system variable millisecs- value on the right.
[CommandMethod("SLP")]
public void cmd_shortestLongestPlinesOnLayer()
{
var e = AcadApp.DocumentManager.MdiActiveDocument.Editor;
using (var tr = e.Document.Database.TransactionManager.StartTransaction())
{
var layerTable = tr.GetObject(e.Document.Database.LayerTableId, OpenMode.ForRead) as LayerTable;
var sw = Stopwatch.StartNew();
var st = (int)AcadApp.GetSystemVariable("millisecs");
foreach (var layerId in layerTable)
{
var layer = tr.GetObject(layerId, OpenMode.ForRead) as LayerTableRecord;
if (layer.Name.Equals("Defpoints") || layer.IsFrozen || layer.IsOff || layer.Name.Contains("|"))
continue;
var pairs = new Dictionary<double, Polyline3d>();
PromptSelectionResult psr;
if (SelectionOfPLines(e, layer.Name, out psr)) continue;
foreach (var id in psr.Value.GetObjectIds())
{
var pline = tr.GetObject(id, OpenMode.ForWrite, false) as Polyline3d;
if (pline.Layer != layer.Name) continue;
pairs.Add(pline.Length, pline);
pline.Erase(true);
}
psr.Value.Dispose();
if (pairs.Count <= 0) continue;
var dict = pairs.Keys;
var maxLine = dict.Max();
var minLine = dict.Min();
var ll = pairs[maxLine];
var sl = pairs[minLine];
ll.Erase(false);
sl.Erase(false);
pairs.Clear();
}
sw.Stop();
var et = (int)AcadApp.GetSystemVariable("millisecs");
e.WriteMessage("\nElapsed={0}msecs. {1}msecs \n", sw.ElapsedMilliseconds, (et - st).ToString());
tr.Commit();
}
}
private static bool SelectionOfPLines(Editor e, string layerName, out PromptSelectionResult psr)
{
TypedValue[] tv = { new TypedValue((int)DxfCode.Start, "POLYLINE"), new TypedValue((int)DxfCode.LayerName, layerName) };
var filter = new SelectionFilter(tv);
psr = e.SelectAll(filter);
return psr.Status != PromptStatus.OK;
}