Author Topic: (entprev)  (Read 56513 times)

0 Members and 1 Guest are viewing this topic.

LE3

  • Guest
Re: (entprev)
« Reply #135 on: December 03, 2013, 01:05:10 PM »
I noticed that on the 'browse all entities" - no idea about the internals on how these guys from basis did back when vlisp was vital lisp.

But anyway, my method that uses the acdbCurDwg()->currentSpaceId() or current space will work better since it will grab the entities on the desired location and also avoiding the use of COM or activex extensions as those from all the vlax-XXXX

There are VLAX- methods for active layout or to get by layout name, too.

But do not know if any of those VLAX- calls are faster or not than the (ssget "_X") all depends in the case you are working.... the ssget "x" will get all, but maybe it will be a need to sort out entities.... difficult to say.


My 0.2 cts.... :)

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: (entprev)
« Reply #136 on: December 03, 2013, 05:14:06 PM »
I have tried this version but seems slower, I need a method to stop (vlax-for ObjFor (vla-get-block LayFor) ...
when find the  (equal EntObj ObjFor) condition.
Code: [Select]
; Version 3.30 - 2013/12/03 - not tested on xref
(defun ALE_EntPrevious (EntNam / EntObj SelSet EntDat Countr EntOut PrnEnt *AcAcDwg* *AcDataB* TrueFl)
  (if
    (and
      (assoc 410 (setq EntDat (entget EntNam)))
      (not (wcmatch (cdr (assoc 0 EntDat)) "ATTRIB,VERTEX"))
    )
    (progn
      (setq
        *AcAcDwg* (vla-get-ActiveDocument (vlax-get-acad-object))
        *AcDataB* (vla-get-database *AcAcDwg*)
        EntObj    (vlax-ename->vla-object EntNam)
      )
      (vlax-for LayFor (vla-get-Layouts *AcDataB*)
        (vlax-for ObjFor (vla-get-block LayFor)
          (if (equal EntObj ObjFor)
            (setq TrueFl T   EntOut (vlax-vla-object->ename EntOut))
            (or TrueFl (setq EntOut ObjFor))
          )
        )
      )
    )
    (setq
      EntOut (entget (cdr (assoc 330 EntDat)))
      EntOut (cdr (cond ((assoc 360 (reverse EntOut)))
                         ((assoc -1 EntOut))
                  )
             )
    )
  )
  (while (and EntOut (not (eq EntNam (setq PrnEnt (entnext EntOut)))))
    (setq EntOut PrnEnt)
  )
  EntOut
)

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: (entprev)
« Reply #137 on: December 03, 2013, 05:36:42 PM »
I need a method to stop (vlax-for ObjFor (vla-get-block LayFor) ...
when find the  (equal EntObj ObjFor) condition.

Not pretty, but should work:
Code: [Select]
(vl-catch-all-apply
    (function
        (lambda ( )
            (vlax-for l (vla-get-layouts *AcDataB*)
                (vlax-for o (vla-get-block l)
                    (if (equal entobj o)
                        (progn
                            (setq entout (vlax-vla-object->ename entout))
                            (exit)
                        )
                        (setq entout o)
                    )
                )
            )
        )
    )
)

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: (entprev)
« Reply #138 on: December 04, 2013, 05:17:35 AM »
I need a method to stop (vlax-for ObjFor (vla-get-block LayFor) ...
when find the  (equal EntObj ObjFor) condition.

Not pretty, but should work: ...

Thanks Lee, I thought (exit) or (quit) but the idea of putting it in a (vl-catch-all-apply ...) I would never come!
Code: [Select]

;Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
; On my entprev.dwg:
; select line 1
;Elapsed milliseconds / relative speed for 8192 iteration(s):
;    (ALE_ENTPREVIOUS KKKK)......1076 / 67.53 <fastest>
;    (ENTPREVMR KKKK)...........72665 / 1 <slowest>

; select line 2 in block
;Elapsed milliseconds / relative speed for 512 iteration(s):
;    (ALE_ENTPREVIOUS KKKK).....2589 / 1.62 <fastest>
;    (ENTPREVMR KKKK)...........4196 / 1 <slowest>

; select Attrib in block 2
;Elapsed milliseconds / relative speed for 16384 iteration(s):
;    (ENTPREVMR KKKK)...........2028 / 1.27 <fastest>
;    (ALE_ENTPREVIOUS KKKK).....2574 / 1 <slowest>

; select OLD polyline 3
;Elapsed milliseconds / relative speed for 16384 iteration(s):
;    (ENTPREVMR KKKK)...........1404 / 1.03 <fastest>
;    (ALE_ENTPREVIOUS KKKK).....1451 / 1 <slowest>

; select line 1
;Elapsed milliseconds / relative speed for 8192 iteration(s):
;    (ALE_ENTPREVIOUS KKKK)................1498 / 10.85 <fastest>
;    (ALE_ENTPREVIOUSBYSS KKKK #SSET).....16255 / 1 <slowest>
Code: [Select]
; Version 3.40 - 2013/12/04 - not tested on Xref
;(setq *AcDataB* (vla-get-database (vla-get-ActiveDocument (vlax-get-acad-object))))
;
(defun ALE_EntPrevious (EntNam / EntObj SelSet EntDat EntOut PrnEnt)
  (if
    (and
      (assoc 410 (setq EntDat (entget EntNam)))
      (not (wcmatch (cdr (assoc 0 EntDat)) "ATTRIB,VERTEX"))
    )
    (progn
      (setq EntObj (vlax-ename->vla-object EntNam))
      (vl-catch-all-apply ; Lee Mac idea
        (function
          (lambda ( )
            (vlax-for l (vla-get-layouts *AcDataB*)
              (vlax-for o (vla-get-block l)
                (if (equal EntObj o)
                  (progn (setq EntOut (vlax-vla-object->ename EntOut)) (exit))
                  (setq EntOut o)
                )
              )
            )
          )
        )
      )
    )
    (setq
      EntOut (entget (cdr (assoc 330 EntDat)))
      EntOut (cdr (cond ((assoc 360 (reverse EntOut)))
                         ((assoc -1 EntOut))
                  )
             )
    )
  )
  (while (and EntOut (not (eq EntNam (setq PrnEnt (entnext EntOut)))))
    (setq EntOut PrnEnt)
  )
  EntOut
)

; Another attempt - Version 1.00 - 2013/12/04 - not tested on Xref
; (setq #SSet (ssget "_X"))
; (ALE_EntPreviousBySS (car (nentsel)) #SSet)
;
(defun ALE_EntPreviousBySS (EntNam SelSet / SelSet EntDat Countr EntOut PrnEnt)
  (if
    (and
      (assoc 410 (setq EntDat (entget EntNam)))
      (not (wcmatch (cdr (assoc 0 EntDat)) "ATTRIB,VERTEX"))
    )
    (progn
      (setq Countr 0)
      (while SelSet
        (if (eq EntNam (ssname SelSet Countr))
          (setq EntOut (ssname SelSet (1+ Countr))  PrnEnt EntOut  SelSet nil)
          (setq Countr (1+ Countr))
        )
      )
    )
    (setq
      EntOut (entget (cdr (assoc 330 EntDat)))
      EntOut (cdr (cond ((assoc 360 (reverse EntOut)))
                         ((assoc -1 EntOut))
                  )
             )
    )
  )
  (while (and EntOut (not (eq EntNam (setq PrnEnt (entnext EntOut)))))
    (setq EntOut PrnEnt)
  )
  EntOut
)

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: (entprev)
« Reply #139 on: December 04, 2013, 10:52:00 AM »
Marc', can you benchmark also this version... I think it's more optimized for entities near end of ss (ssname (ssget "_X") 0) or (entlast)... It would be nice to see if this version is actually faster than orig. (entprevMR)...

Code - Auto/Visual Lisp: [Select]
  1. (defun entprevMR-SS ( e / i ss e1 e2 )
  2.   (setq i -1)
  3.   (setq ss (ssget "_X"))
  4.   (while (not (or (eq e (ssname ss (setq i (1+ i)))) (eq (cdr (assoc 330 (entget e))) (ssname ss i)))))
  5.   (if (eq (type e) 'ename)
  6.     (if (eq e (entnext))
  7.       nil
  8.       (if (wcmatch (cdr (assoc 0 (entget e))) "ATTRIB,VERTEX,SEQEND")
  9.         (progn
  10.           (setq e1 (cdr (assoc 330 (entget e))))
  11.           (while (and e1 (not (eq e (setq e2 (entnext e1)))))
  12.             (setq e1 e2)
  13.           )
  14.           e1
  15.         )
  16.         (if (wcmatch (cdr (assoc 2 (entget (cdr (assoc 330 (entget e)))))) "*Model_Space,*Paper_Space")
  17.           (progn
  18.             (setq e1 (cdr (assoc 360 (reverse (entget (cdr (assoc 330 (entget e))))))))
  19.             (if (eq (cdr (assoc 0 (entget e1))) "BLOCK") (setq e1 (ssname ss (1+ i))))
  20.             (while (and e1 (not (eq e (setq e2 (entnext e1)))))
  21.               (setq e1 e2)
  22.             )
  23.             e1
  24.           )
  25.           (progn
  26.             (setq e1 (tblobjname "BLOCK" (vla-get-name (vlax-ename->vla-object (cdr (assoc 330 (entget e)))))))
  27.             (while (and e1 (not (eq e (setq e2 (entnext e1)))))
  28.               (setq e1 e2)
  29.             )
  30.             e1
  31.           )
  32.         )
  33.       )
  34.     )
  35.     (entget e)
  36.   )
  37. )
  38.  
  39. (defun c:test ( / e loop n )
  40.   ;;; last nested or parent entity - e ;;;
  41.   (setq e (entlast))
  42.   (setq loop t)
  43.   (while loop
  44.     (if (entnext e) (setq e (entnext e)) (setq loop nil))
  45.   )
  46.   ;;; test - entprev ;;;
  47.   (setq n 0)
  48.   (while e
  49.     (setq n (1+ n))
  50.     (setq e (entprevMR-SS e))
  51.   )
  52.   (prompt "\nTesting entprev function; Total: ")
  53.   (if (= n 1)
  54.     (progn
  55.       (princ n) (prompt " nested/parent entity")
  56.     )
  57.     (progn
  58.       (princ n) (prompt " nested/parent entities")
  59.     )
  60.   )
  61.   ;;; first parent entity - e ;;;
  62.   (setq e (entnext))
  63.   ;;; test - entnext ;;;
  64.   (setq n 0)
  65.   (while e
  66.     (setq n (1+ n))
  67.     (setq e (entnext e))
  68.   )
  69.   (prompt "\nTesting entnext function; Total: ")
  70.   (if (= n 1)
  71.     (progn
  72.       (princ n) (prompt " nested/parent entity")
  73.     )
  74.     (progn
  75.       (princ n) (prompt " nested/parent entities")
  76.     )
  77.   )
  78.   (princ)
  79. )
  80.  

(entprevMR-SS) also passed all my tests...

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: (entprev)
« Reply #140 on: December 04, 2013, 03:50:47 PM »
Marc', can you benchmark also this version... I think it's more optimized for entities near end of ss (ssname (ssget "_X") 0) or (entlast)... It would be nice to see if this version is actually faster than orig. (entprevMR)...
M.R.
Marko, I am doing tests, (ssget "_X") is very slow, this version use a selset as argument:
; (setq #SSet (ssget "_X"))  <<<<<<< I set only one time! But it is slower again.
; (ALE_EntPreviousBySS (car (nentsel)) #SSet)
Code: [Select]
; select line 1
;Elapsed milliseconds / relative speed for 8192 iteration(s):
;    (ALE_ENTPREVIOUS KKKK)................1498 / 10.85 <fastest>
;    (ALE_ENTPREVIOUSBYSS KKKK #SSET).....16255 / 1 <slowest>

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: (entprev)
« Reply #141 on: December 04, 2013, 05:20:10 PM »
Marc', can you benchmark also this version... I think it's more optimized for entities near end of ss (ssname (ssget "_X") 0) or (entlast)... It would be nice to see if this version is actually faster than orig. (entprevMR)...
M.R.
Code: [Select]
;Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
; select line 1
;Elapsed milliseconds / relative speed for 8192 iteration(s):
;    (ALE_ENTPREVIOUS KKKK).......1029 / 568.52 <fastest>
;    (ENTPREVMR-SS KKKK)........585004 / 1 <slowest>
I can not do other tests, to much difference
Code: [Select]

; select line 1
;Elapsed milliseconds / relative speed for 128 iteration(s):
;    (ENTPREVMR KKKK)........1092 / 8.73 <fastest>
;    (ENTPREVMR-SS KKKK).....9531 / 1 <slowest>
I can not do other tests, to much difference


ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: (entprev)
« Reply #142 on: December 04, 2013, 05:55:27 PM »
Thanks, Marc' for benchmarking... I thought so that SS version is slower in situations with testing on firstly created entities... I don't know this line in benchmark :
Code: [Select]
; select line 1
Does this mean that you're testing functions on first line in DWG with plenty of them?
Also on what entity is referenced KKKK?
Or you are cycling through all of them similar to my (c:test) function from last to first entity...
Is SS version slower than orig. version in this case from last to first entity?

If KKKK entity is first one (setq KKKK (entnext (entnext))), can you benchmark it with last one (setq KKKK (entlast) loop t) (while loop (if (entnext KKKK) (setq KKKK (entnext KKKK)) (setq loop nil)))...

Or is KKKK actually : (setq KKKK (ssname (ssget "_X") (1- (fix (/ (sslength (ssget "_X")) 2.0)))))
« Last Edit: December 04, 2013, 06:19:07 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: (entprev)
« Reply #143 on: December 04, 2013, 06:58:29 PM »
Here are my results between (entprevMR) and (entprevMR-SS) :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:test-benchmark ( / ss e )
  2. ; Results on 10000 PELLIPSE entities ;
  3. ;------------------------------------;
  4.   (setq ss (ssget "_X"))
  5. ;  (setq e (ssname ss (1- (sslength ss))))                  ;;; (entprevMR e) = 0 ;;; (entprevMR-SS e) = 202 ;;;
  6. ;  (setq e (ssname ss (1- (fix (/ (sslength ss) 2.0)))))    ;;; (entprevMR e) = 78 ;;; (entprevMR-SS e) = 125 ;;;
  7. ;  (setq e (ssname ss 0))                                   ;;; (entprevMR e) = 140 ;;; (entprevMR-SS e) = 15 ;;;
  8.                                                             ;;;--------------------------------------------------;;;
  9.                                                             ;;;  (entprevMR e) = 218 ;;; (entprevMR-SS e) = 342  ;;;
  10.                                                             ;;; 342/218 = 1.57 faster (entprevMR)/(entprevMR-SS) ;;;
  11.   (setq t1 (car (_vl-times)))
  12.   (entprev e)
  13.   (setq t2 (car (_vl-times)))
  14.   (princ (- t2 t1))
  15.   (princ)
  16. )
  17.  
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: (entprev)
« Reply #144 on: December 05, 2013, 03:18:54 AM »
Here are my results between (entprevMR) and (entprevMR-SS) :
...
Marko,
I forgot to write (as I did above)   >>>; On my entprev.dwg:
about:
; select line 1
; select line 2 in block
; select Attrib in block 2
; select OLD polyline 3
see figure on my dwg.

About kkkk: it simply a variable, Benchmark is Benchmark.lsp by Michael Puckett:
Code: [Select]
(setq kkkk (car (nentsel)))
(Benchmark '(
   (entprevMR kkkk) ;Marko Ribar
   (ALE_EntPrevious kkkk)
)           )

My 2 cents: the problem un performance is in DWG with many complex entities PEllipse, 3Dline, Blocks with many attribs and when you select a simple entity (line) to avoid to iterate over all sub-entities as in my sample dwg.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: (entprev)
« Reply #145 on: December 08, 2013, 12:58:57 PM »
...
But anyway, my method that uses the acdbCurDwg()->currentSpaceId() or current space will work better since it will grab the entities on the desired location and also avoiding the use of COM or activex extensions as those from all the vlax-XXXX
...
Louis,
I have tested (in my entprev.dwg) your function again and:
Code: [Select]
(defun C:TestentpreviousFrom ( / SelSet Countr EntNam EntPrv Countr)
  (setq EntNam (ssname (ssget "_X") 0) Countr 0)
  (while EntNam
    (if (setq EntPrv (entpreviousFrom EntNam))
      (or
        (eq EntNam (entnext EntPrv))
        (progn (print (cdr (assoc 0 (entget EntNam)))) (princ " Not Eq "))
      )
      (progn (print (cdr (assoc 0 (entget EntNam))))(princ " nil "))
    )
    (setq EntNam (entnext EntNam)  Countr (1+ Countr))
  )
  Countr
)
My fuction return nil only for seqend:
...
"SEQEND"  nil
"SEQEND"  nil 6274

Your function:
....
"SEQEND"  nil
"INSERT"  nil
"SEQEND"  nil
"LWPOLYLINE"  nil
"SEQEND"  nil
"POLYLINE"  nil
"SEQEND"  nil
"LWPOLYLINE"  nil
...
and Not Eq in:
...
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"LWPOLYLINE"  Not Eq
"POLYLINE"  Not Eq
"LWPOLYLINE"  Not Eq
6274


LE3

  • Guest
Re: (entprev)
« Reply #146 on: December 08, 2013, 01:25:25 PM »
...
But anyway, my method that uses the acdbCurDwg()->currentSpaceId() or current space will work better since it will grab the entities on the desired location and also avoiding the use of COM or activex extensions as those from all the vlax-XXXX
...
Louis,
I have tested (in my entprev.dwg) your function again and:
Code: [Select]
(defun C:TestentpreviousFrom ( / SelSet Countr EntNam EntPrv Countr)
  (setq EntNam (ssname (ssget "_X") 0) Countr 0)
  (while EntNam
    (if (setq EntPrv (entpreviousFrom EntNam))
      (or
        (eq EntNam (entnext EntPrv))
        (progn (print (cdr (assoc 0 (entget EntNam)))) (princ " Not Eq "))
      )
      (progn (print (cdr (assoc 0 (entget EntNam))))(princ " nil "))
    )
    (setq EntNam (entnext EntNam)  Countr (1+ Countr))
  )
  Countr
)
My fuction return nil only for seqend:
...
"SEQEND"  nil
"SEQEND"  nil 6274

Your function:
....
"SEQEND"  nil
"INSERT"  nil
"SEQEND"  nil
"LWPOLYLINE"  nil
"SEQEND"  nil
"POLYLINE"  nil
"SEQEND"  nil
"LWPOLYLINE"  nil
...
and Not Eq in:
...
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"INSERT"  Not Eq
"LWPOLYLINE"  Not Eq
"POLYLINE"  Not Eq
"LWPOLYLINE"  Not Eq
6274

Hi Marco,
The function 'BrowseAllEntities' uploaded as source code where I have the call:
AcDbBlockTableRecordPointer pBTR(acdbCurDwg()->currentSpaceId(), AcDb::kForRead);

Here:
http://www.theswamp.org/index.php?topic=45732.msg509295#msg509295

It is part of an internal command on my solution not avail and was to demonstrate how the one in visual lisp was made or implemented (I can make that as command to tested if needed).

The latest exported autolisp function of 'EntPreviousFrom' I uploaded a few days ago here:
http://www.theswamp.org/index.php?topic=45732.msg509185#msg509185

And the reason I have done my uploads on separate messages it is to reflect the changes, and in some case anyone one day end up using the code, can do a comparison too.

HTH.

Luis.