I have a old program I'm trying to update for 2014. It would prompt you to pick a segment of a polyline then return the vertices of that segment and for the adjacent segment on eash side.
(setq pline (entsel "\nSelect end of Slab"))
(setvar "osmode" 0)
(setq pl (car pline)
pl1 (entget pl)
pick (cadr pline)
plObj (vlax-ename->vla-object pl)
pick2 (vlax-curve-getclosestpointto plobj pick)
param (vlax-curve-getparamatpoint plObj pick2)
segment (fix param)
vertlist (get-vertices pl1))
(if (= segment 0)(setq apt1 (nth (1- (cdr (assoc 90 pl1))) vertlist))(setq apt1 (nth (1- segment) vertlist)))
(setq apt2 (nth segment vertlist))
(if (= segment (1- (cdr (assoc 90 pl1))))(setq apt3 (nth 0 vertlist))(setq apt3 (nth (1+ segment) vertlist)))
(if (= segment (1- (cdr (assoc 90 pl1))))(setq apt4 (nth 1 vertlist))(setq apt4 (nth (+ 2 segment) vertlist)))
When I try this in AutoCAD 2014 I get something like;
Command: !vertlist
((10304.7 765.717) 0 0.0 0.0 0.0 (10544.7 729.717) 0 0.0 0.0 0.0 (10544.7 1271.72) 0 etc.
It doesn't appear to return the complete list of vertices and I also don't know where all of those 0's came from.
Can anybody help me debug this?
Solved! Go to Solution.
Solved by Kent1Cooper. Go to Solution.
I don't have access to 2014 at the moment, but I seem to recall someone else having difficulties with Polyline entity data, which I believe in that version has [or maybe sometimes has] additional entries in it compared to earlier versions. They were doing something that depended on the actual position in the entity data list of certain entries, or maybe the number of entries between vertex position entries, rather than their association-list numbers. If your (get-vertices) function gets them in some way like that, it would have a similar problem. If you post that function definition, and an example of the entity data list from a Polyline, it should be easy enough to tell.
Here's a way that doesn't depend on those kinds of things, and ought to work in any version, and which does various other aspects of the task more concisely:
(defun ptpar (par) (reverse (cdr (reverse (vlax-curve-getPointAtParam plent par)))))
; = PoinT on polyline at PARameter value [X & Y coordinates only]
; If XYZ usable, just: (defun ptpar (par) (vlax-curve-getParamAtPoint plent par))
(setq plsel (entsel "\nSelect end of Slab")); the PolyLine SELection
(setvar "osmode" 0)
(setq
plent (car plsel); the PolyLine ENTity name
verts (cdr (assoc 90 (entget plent))); number of VERTiceS
prepar (fix (vlax-curve-getParamAtPoint plent (osnap (cadr plsel) "_nea")))
; PREceding-pick-point vertex's PARameter value
apt1 (ptpar (rem (1- (+ prepar verts)) verts))
apt2 (ptpar prepar)
apt3 (ptpar (rem (1+ prepar) verts))
apt4 (ptpar (rem (+ 2 prepar) verts))
); setq
[The (vlax-curve-...) functions can take entity names directly as well as VLA objects, so you don't need to make that conversion.]
Consider whether to add entity-type selection control, and a check on whether the selected Polyline is closed, on which this all depends, as well as the other usual stuff [saving and resetting OSMODE, error handling, etc.] if they are not already included in the surrounding code that you didn't include.
Post the code for get-vertices which is probably the heart of your problem.
(defun get-vertices (data / vlist points)
(setq vlist (member (assoc 10 data) data))
(repeat (cdr (assoc 90 data))
(setq points (cons (cdar vlist) points) vlist (cddddr vlist)))
(reverse points)
)
But the solution Kent offered workrd so you don't need to do any more work on this, unless you just want to.
@spykat wrote:
(defun get-vertices (data / vlist points)
(setq vlist (member (assoc 10 data) data))
(repeat (cdr (assoc 90 data))
(setq points (cons (cdar vlist) points) vlist (cddddr vlist)))
(reverse points)
)
But the solution Kent offered workrd so you don't need to do any more work on this, unless you just want to.
That's as I suspected -- the (member) function takes off everything before the first vertex location entry, it gets the location from the first remaining entry, and then the (cddddr) lops the first four entries [vertex location, starting width, ending width, bulge factor] off the beginning of the list, intending that the first entry in what's left is the next vertex location. That's fine in earlier versions, but in Acad2014, there is [or sometimes can be?] an additional entry between [I forget what it's for -- no access to that here], so it would be necessary to lop the first five entries off each time, for it to work right. That's why something that looks at vertex locations for themselves [in my suggestion, integer parameter values, but there are other ways], rather than at every fourth entry in the entity data, works in any version.
Glad you got your solution. Instead of get-verticies, this little function, by Michael Puckett, is a good way to process entity lists.
(cdrs 10 <entity list>)
;;;This little routine will return a list of all ;;;instances of the supplied association pointer. Use like so: ;;;(cdrs 10 (entget (car (entsel "\nSelect a polyline")))) ;;;returns something like this: ;;;((259.943 -252.219) (214.182 -140.305) (254.223 -92.925) (215.0 -21.0386) ;;;(253.406 41.8621) (215.817 112.115)) ;;;Michael Puckett (defun cdrs (key lst / pair rtn) (while (setq pair (assoc key lst)) (setq rtn (cons (cdr pair) rtn) lst (cdr (member pair lst)) ) ) (reverse rtn) )
@dbroad3 wrote:
.... Instead of get-verticies, this little function, by Michael Puckett, is a good way to process entity lists.
(cdrs 10 <entity list>)
....
Another way to do the same, requiring neither localized variables nor reversal at the end:
(defun cdrs (key lst)
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (= (car x) key))
lst
)
)
)
[It does require running (vl-load-com) if that's not already done.]
@Kent "Another way to do the same, requiring neither localized variables nor reversal at the end:"
which makes one think it might be more efficient or faster. In fact, Michael's routine runs about twice as fast probably due to the optimization of the member function.
@spykat You're welcome.
Kent1Cooper wrote
[It does require running (vl-load-com) if that's not already done.]
If I remember correctly, vl-* functions don't require vl-load-com, only vla-* / vlax-* and maybe vlr-*
@dbroad3 wrote:@KenT "Another way to do the same, requiring neither localized variables nor reversal at the end:"
which makes one think it might be more efficient or faster. In fact, Michael's routine runs about twice as fast probably due to the optimization of the member function.
Regarding the performance of various 'mAssoc' functions, here is a quick study:
(defun mAssoc1 ( key lst / rtn ) (foreach x lst (if (= key (car x)) (setq rtn (cons (cdr x) rtn)) ) ) (reverse rtn) ) (defun mAssoc2 ( key lst ) (apply 'append (mapcar (function (lambda ( x ) (if (= key (car x)) (list (cdr x)))) ) lst ) ) ) (defun mAssoc3 ( key lst ) (mapcar 'cdr (vl-remove-if-not (function (lambda ( x ) (= key (car x)))) lst ) ) ) (defun mAssoc4 ( key lst / item ) (if (setq item (assoc key lst)) (cons (cdr item) (mAssoc4 key (cdr (member item lst)))) ) ) (defun mAssoc5 ( key lst / item rtn ) (while (setq item (assoc key lst)) (setq rtn (cons (cdr item) rtn) lst (cdr (member item lst))) ) (reverse rtn) ) (defun mAssoc6 ( key lst ) (mapcar 'cdr (acet-list-m-assoc key lst)) ) (defun mAssoc7 ( key lst ) (if lst (if (= key (caar lst)) (cons (cdar lst) (mAssoc7 key (cdr lst))) (mAssoc7 key (cdr lst)) ) ) ) ;;; Benchmarking: Elapsed milliseconds / relative speed for 32768 iteration(s): ;;; ;;; (MASSOC4 2 L).....1482 / 1.25 <fastest> ;;; (MASSOC5 2 L).....1482 / 1.25 ;;; (MASSOC6 2 L).....1498 / 1.24 ;;; (MASSOC3 2 L).....1638 / 1.13 ;;; (MASSOC7 2 L).....1747 / 1.06 ;;; (MASSOC1 2 L).....1748 / 1.06 ;;; (MASSOC2 2 L).....1856 / 1 <slowest>
@Lee_Mac wrote:
Regarding the performance of various 'mAssoc' functions, here is a quick study:
Benchmarking: Elapsed milliseconds / relative speed for 32768 iteration(s):;;;;;; (MASSOC4 2 L).....1482 / 1.25 <fastest>;;; (MASSOC5 2 L).....1482 / 1.25;;; (MASSOC6 2 L).....1498 / 1.24;;; (MASSOC3 2 L).....1638 / 1.13;;; (MASSOC7 2 L).....1747 / 1.06;;; (MASSOC1 2 L).....1748 / 1.06;;; (MASSOC2 2 L).....1856 / 1 <slowest>
So even the slowest one takes all of about 1/18 of a millisecond to do it once [on however long a list you used] -- I can't get too worked up over the differences. When, as in the task in this thread, a User selection of a single object is involved, the differences could not be even remotely detectable [it's over in a tiny fraction of a blink of an eye, no matter how slow a function you use], and are therefore meaningless. If you have some reason to process a very large number of long lists collectively in the same way, the differences might get to be slightly noticeable, but still -- less than one second's difference for nearly 33,000 of them....
[And by the way, Lee, every time you post something with color-differentiated code in a code window, when I reply and pick QUOTE, that part of it comes in severely whacked out -- in this case, every single blue word is its own separate new line, not in a code window, with every stretch of black code in between them in its own separate code window [that's a heck of a lot of 'em], and the green stuff has lost all line breaks as quoted above. I don't know whether it's just you -- I don't often see code windows with colors in them from other people to compare. Or maybe it's just me -- I'd be interested to know whether the same thing happens for other people. I pointed it out to the Forum moderators once, as another of several reasons I don't like code windows, but haven't seen any response yet, nor obviously any correction.]
@Kent1Cooper wrote:So even the slowest one takes all of about 1/18 of a millisecond to do it once [on however long a list you used] -- I can't get too worked up over the differences. When, as in the task in this thread, a User selection of a single object is involved, the differences could not be even remotely detectable [it's over in a tiny fraction of a blink of an eye, no matter how slow a function you use], and are therefore meaningless.
I think we may have to agree to disagree on this one Kent; regardless of whether the difference in efficiency is noticeable or not, I disagree that the differences are 'meaningless' and tend to strive for good efficiency when writing any program (whilst maintaining a balance of readability of course).
In my opinion, disregarding differences in efficiency breeds lazy programming, which is veiled by the incredible processing power of modern computers. Nevertheless, the way I see it, if there is an opportunity to use a more efficient construct with little to no loss in program readability or maintainability, then why wouldn't you...
@Kent1Cooper wrote:[And by the way, Lee, every time you post something with color-differentiated code in a code window, when I reply and pick QUOTE, that part of it comes in severely whacked out -- in this case, every single blue word is its own separate new line, not in a code window, with every stretch of black code in between them in its own separate code window [that's a heck of a lot of 'em], and the green stuff has lost all line breaks as quoted above. I don't know whether it's just you -- I don't often see code windows with colors in them from other people to compare. Or maybe it's just me -- I'd be interested to know whether the same thing happens for other people. I pointed it out to the Forum moderators once, as another of several reasons I don't like code windows, but haven't seen any response yet, nor obviously any correction.]
The problem is likely caused by the Rich Text post editor automatically extracting text with formatting tags from inside the code tags (why it should do this, I have no idea), hence the code block is broken up by those sections with formatting applied.
I tend to use the HTML post editor by default in which there is no such problem.
Lee
Hi Lee,
what do you think of this old test of Tony Tanzillo (about May 2000)?
(defun mAssoc3 ( key lst ) (mapcar 'cdr (vl-remove-if-not (function (lambda ( x ) (= key (car x)))) lst ) ) ) (defun mAssoc4 ( key lst / item ) (if (setq item (assoc key lst)) (cons (cdr item) (mAssoc4 key (cdr (member item lst)))) ) ) (defun mAssoc5 ( key lst / item rtn ) (while (setq item (assoc key lst)) (setq rtn (cons (cdr item) rtn) lst (cdr (member item lst))) ) (reverse rtn) ) ;; Average a list of numbers after throwing ;; out highest and lowest values: (defun refine-average (numlist) (/ (- (apply '+ numlist) (apply 'max numlist) (apply 'min numlist) ) (- (length numlist) 2) ) ) ;; Return time (in seconds) to evaluate quoted expression: ;; ;; (time '(myfunc arg)) ;; (defun time (expr) (/ (abs (- (getvar "millisecs") (progn (eval expr) (getvar "millisecs")) ) ) 1000.0 ) ) ; Tony Tanzillo - about May 2000 (defun C:TEST ( / time1 time2 time3 time4 iter *error* l f) (defun *error* (s) (princ)) (if (not data) (progn (princ "\nUSE SPARSE-DATA, DENSE-DATA, OR PLINE-DATA to create test data") (exit) ) ) (setq time4 0.0 time3 0.0 time2 0.0 time1 0.0 iter 10) (repeat iter (setq time1 (+ time1 (time '(repeat 50 (mAssoc5 10 data))))) (setq time2 (+ time2 (time '(repeat 50 (mAssoc3 10 data))))) (setq time3 (+ time3 (time '(repeat 50 (mAssoc3 10 data))))) (setq time4 (+ time4 (time '(repeat 50 (mAssoc5 10 data))))) ) (princ (strcat "\nInput list length: " (itoa (setq l (length data))) "\nResult list length: " (itoa (setq f (length (mAssoc5 10 data)))) "\nFound/Total ratio: " (rtos (/ (float f) l) 2 2) ) ) (princ (strcat "\nAverage of 10 x 50 iterations: " "\nmAssoc5: " (rtos (/ time1 iter) 2 4) "\nmAssoc3: " (rtos (/ time2 iter) 2 4) "\nmAssoc3: " (rtos (/ time3 iter) 2 4) "\nmAssoc5: " (rtos (/ time4 iter) 2 4) ) ) (princ) ) (defun C:SPARSE-DATA ( / size) (setq size (getint "\nList length: ")) (setq data nil) (repeat (/ size 20) (setq data (append data '( (10 0.0 0.0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) ) ) ) ) (c:test) (princ) ) (defun C:DENSE-DATA ( / size) (setq size (getint "\nList length: ")) (setq data nil) (repeat (/ size 4) (setq data (append data '( (10 0.0 0.0) (0 . 0) (0 . 0) (0 . 0) ) ) ) ) (c:test) (princ) ) (defun C:PLINE-DATA ( / vertices point ) (setq vertices (getint "\nNumber of vertices: ")) (setq point '(0.0 0.0 0.0)) (setvar "CMDECHO" 0) (command "._pline" point) ;; plinetype > 0 (repeat (1- vertices) (command (setq point (polar point 0.0 1.0))) ) (command "") (setq data (entget (entlast))) (c:test) )
SPARSE-DATA Input list length: 15000 Result list length: 750 Found/Total ratio: 0.05 Average of 10 x 50 iterations: mAssoc5: 0.2138 mAssoc3: 0.3931 mAssoc4: 0.1872 mAssoc7: 0.6785 SPARSE-DATA Input list length: 32000 Result list length: 1600 Found/Total ratio: 0.05 Average of 10 x 50 iterations: mAssoc5: 0.4556 mAssoc3: 1.0311 mAssoc4: 0.5227 mAssoc5: 0.4882 >>> see *1* DENSE-DATA Input list length: 15000 Result list length: 3750 Found/Total ratio: 0.25 Average of 10 x 50 iterations: mAssoc5: 0.3668 mAssoc3: 0.4586 mAssoc4: 0.3665 mAssoc7: 0.7612 DENSE-DATA Input list length: 32000 Result list length: 8000 Found/Total ratio: 0.25 Average of 10 x 50 iterations: mAssoc5: 1.5757 mAssoc3: 1.8892 mAssoc4: 1.538 mAssoc5: 1.4446 >>> see *1* omando: PLINE-DATA Number of vertices: 32000 Input list length: 160015 Result list length: 32000 Found/Total ratio: 0.2 Average of 10 x 50 iterations: mAssoc5: 4.5631 mAssoc3: 6.0216 mAssoc3: 6.7376 >>> see *2* mAssoc5: 4.2635 >>> see *1* *1* mAssoc7 do not support long list (about > 16000) so I put mAssoc5 again *2* mAssoc4 do not support long list (about > 16000) so I put mAssoc3 again
Very thorough Marc - thanks for sharing the results!
...perhaps this can be interesting (or surprising):
(defun ALE_List_MAssoc (DxfKey ImpLst / TmpLst OutLst TmpPos) (while (setq TmpLst (assoc DxfKey ImpLst)) (setq TmpPos (vl-position TmpLst ImpLst) OutLst (cons (cdr TmpLst) OutLst) ImpLst (cdr (ALE_List_CdrByPos TmpPos ImpLst)) ) ) (reverse OutLst) ) (defun Cd10r (l) (cddddr(cddddr(cddr l))) ) (defun Cd100r (l) (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr l))))))))))))))))))))))))) ) (defun Cd1000r (l) (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr(cddddr(cddddr (cddddr(cddddr(cddddr(cddddr(cddddr l)))))))))))) ))))))))))))))))))))))))))))))))))))))))))))))))) ))))))))))))))))))))))))))))))))))))))))))))))))) ))))))))))))))))))))))))))))))))))))))))))))))))) ))))))))))))))))))))))))))))))))))))))))))))))))) )))))))))))))))))))))))))))))))))))))))))) ) ; Pos is Nth like (defun ALE_List_CdrByPos (n l / r) (cond ( (> n 1000) (repeat (/ n 1000) (setq l (Cd1000r l))) (repeat (/ (setq n (rem n 1000)) 100) (setq l (Cd100r l))) (repeat (/ (setq n (rem n 100)) 10) (setq l (Cd10r l))) (repeat (/ (setq n (rem n 10)) 4) (setq l (cddddr l))) (repeat (rem n 4) (setq l (cdr l))) l ) ( T (setq l (reverse l) n (- (length l) n)) (repeat (/ n 10) (setq r (vl-list* (cadddr (cddddr (cddr l))) (cadddr (cddddr (cdr l))) (cadddr (cddddr l)) (cadddr (cdddr l)) (cadddr (cddr l)) (cadddr (cdr l)) (cadddr l) (caddr l) (cadr l) (car l) r ) l (cddddr (cddddr (cddr l))) ) ) (repeat (rem n 10) (setq r (cons (car l) r) l (cdr l) )) r ) ) )
(progn (setq alist (atoms-family 1)) (setq alist (append alist alist alist alist alist)) (setq alist (append alist alist alist alist alist)) (setq alist (append alist alist alist alist alist)) (princ "\nLength alist : ") (princ (length alist)) (princ " \n") (setq Countr 0 alist2 nil) (foreach ForElm alist (setq Countr (1+ Countr) alist2 (cons (cons (itoa Countr) ForElm) alist2) ) ) (setq alist2 (append alist2 alist2 alist2 alist2 alist2 alist2 alist2 alist2 alist2 alist2 alist2 alist2)) (princ "\nLength alist2: ") (princ (length alist2)) (princ " \n") (princ) ) Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved Length alist : 500625 Length alist2: 12015000 Elapsed milliseconds / relative speed for 1 iteration(s): (ALE_LIST_MASSOC "100" ALIST2).....2340 / 1.7 <fastest> (MASSOC5 "100" ALIST2).............3978 / 1 <slowest> Length alist : 500625 Length alist2: 6007500 Elapsed milliseconds / relative speed for 2 iteration(s): (ALE_LIST_MASSOC "100" ALIST2).....1747 / 2.55 <fastest> (MASSOC5 "100" ALIST2).............4462 / 1 <slowest>
This is the rigth version of ALE_List_CdrByPos:
; 2014/02/19 - n (Position) is Nth like (defun ALE_List_CdrByPos (n l) (repeat (/ n 1000) (setq l (Cd1000r l))) (repeat (/ (setq n (rem n 1000)) 100) (setq l (Cd100r l))) (repeat (/ (setq n (rem n 100)) 10) (setq l (Cd10r l))) (repeat (/ (setq n (rem n 10)) 4) (setq l (cddddr l))) (repeat (rem n 4) (setq l (cdr l))) l )
These days I use vla-objects.
Say that plobj is an LWPolyline vla-object.
(setq vertlist (@group (vlax-get plobj 'coordinates) 2)) where: (defun @group (old n / item new) (while old (while (< (length item) n) (setq item (cons (car old) item) old (cdr old)) ) (setq new (cons (reverse item) new) item nil) ) (reverse new) )
When dealing with heavies or 3Ds, change the 2 to a 3.
John F. Uhden
@j.cordero wrote:
amm , & code VBA activex
I give up.... What is this about? Since it's "in reply to" me, to what part of which Message of mine are you replying? What brings you to it after 4-1/2 years? What does it have to do with the Subject of the thread? [The only things I have found involving "amm" and AutoCAD have nothing whatever to do with it, as far as I can tell.]