All Activity

No, I mean the data returned by my (LM:arraydata) function - you just assumed you should use the length of the list, without actually checking what the list contains.

P.S.: This is just my two cents — though to be honest, it’s probably counterfeit

This is the first time I’ve ever done an “autopsy” on an object like this. I’ve carefully extracted what seemed to me to be the information I was looking for. So I must say: DRIVE CAREFULLY AND RESPECT ALL STOP SIGNS.

(defun c:CountElemArrayrect (/ ss n pt ent le dameFFCC) (defun dameFFCC (ent / items rows cont cols filas) (foreach l (entget (cdr (assoc 330 (entget (cdr (assoc 330 (entget ent))))))) (cond (items (if (= (setq cont (+ (if cont cont 0) (if (= (car l) 90) 1 0))) 3) (setq cols (cdr l) items nil cont nil))) (rows (if (= (setq cont (+ (if cont cont 0) (if (= (car l) 90) 1 0))) 3) (setq filas (cdr l) rows nil cont nil))) ((= (car l) 1) (if (= (cdr l) "Items") (setq items T) (if (= (cdr l) "Rows") (setq rows T)) ) ) ) ) (if (and filas cols) (* filas cols)) ) (princ "Select a arrayrect: ") ;;; (setq ss (ssget '((0 . "ARRAY"))) ;;; n 0) (if (and (setq ent (car (entsel))) (= (cdr (assoc 0 (setq le (entget ent)))) "INSERT") (= "ACDBASSOCDEPENDENCY" (cdr (assoc 0 (entget (cdr (assoc 330 le))))))) (progn (setq n (dameFFCC ent)) ;;; (vla-get-Count ;;; (vlax-ename->vla-object (ssname ss 0)))) (princ (strcat "The number of elements in the array: " (itoa n))) (princ "Specify the insertion point of the text: ") (setq pt (getpoint)) (if pt (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 1 (itoa n)) (cons 40 25) ; text height (cons 7 (getvar "TEXTSTYLE")) ) ) ) ) ) (princ) )

number of array elements.dwg

If you post an example drawing, maybe someone else will be encouraged to join the conversation.

DXF data ( (-1 . <Object name: 233aa8f9cf0>) (0 . "INSERT") (5 . "17957") (102 . "{ACAD_REACTORS") (330 . <Object name: 233aa8f9d80>) (102 . "}") (330 . <Object name: 23bc15009f0>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "Hatching") (100 . "AcDbBlockReference") (2 . "*U268") (10 77260.1 54657.3 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0) ) I've looked at the data, but I need professional help... How can I count elements in an array in lisp?

Did you even look at the data that my function returns?

The code writes the same amount for arrays with different numbers of elements... (defun c:ArrCountTxt ( / ent arrData count insPt txtHeight) (prompt "Select a arrayrect: ") (setq ent (car (entsel))) (if (and ent (= "INSERT" (cdr (assoc 0 (entget ent))))) (progn (setq arrData (LM:arraydata ent)) ;; count the number of elements (setq count (length arrData)) (princ (strcat "Number of array elements: " (itoa count))) (prompt "Specify the insertion point of the text: ") (setq insPt (getpoint)) (setq txtHeight 20) (entmake (list (cons 0 "TEXT") (cons 8 (cdr (assoc 8 (entget ent)))) ; (cons 10 insPt) (cons 40 txtHeight) (cons 1 (strcat "Quantity: " (itoa count))) (cons 7 "Standard") (cons 50 0.0) ) ) ) ) (princ) ) (defun LM:arraydata ( ent / enx lst rtn ) (if (and (setq enx (entget ent)) (= "INSERT" (cdr (assoc 0 enx))) (setq lst (vl-some (function (lambda ( x ) (if (and (= 330 (car x)) (= "ACDBASSOCDEPENDENCY" (cdr (assoc 0 (entget (cdr x)))))) (cdr (assoc 330 (entget (cdr x)))) ) ) ) (member '(102 . "{ACAD_REACTORS") enx) ) ) (setq lst (entget lst)) (setq lst (cons nil (member (assoc 1 lst) lst))) ) (while lst (setq rtn (cons (cons (cdadr lst) (cdar (cddddr lst))) rtn) lst (cdddr (cddddr lst)) ) ) ) (reverse rtn) )

(defun c:LE-CalExtFFL ( / pt1 pt2 pt3 r TxtRotation TxtJustification radians degrees ecoA para) (setq ecoA (getvar "CMDECHO")) (setvar "CMDECHO" 0) (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object))) (command "_layer" "_m" "-LE-E-External Levels" "") (setq Prefix "") (setq Suffix "") (while (and (not para) (setq ffl-ent (car (entsel))) (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT") ) (if (setq r (vl-catch-all-apply '(lambda () ;; Get the MText object and extract text content (setq ffl-obj (entget ffl-ent)) (setq ffl-text (cdr (assoc 1 ffl-obj))) (princ (strcat "\nFFL Text found: " ffl-text)) (setq ffl-value (ExtractFFLValue ffl-text)) (princ "\nSelect points where to place the level text (Press Enter to finish): ") (if ffl-value (if (setq pt1 (getpoint "\nSelect first point: ")) (if (setq pt2 (getpoint pt1 "\nSelect second point: ")) (virtualiza) ) ) ) ) ) ) (setq para T) ) ) (if r (progn (entdel (entlast)) (princ "\r"))) (setvar "CMDECHO" ecoA) (princ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun virtualiza (/ para grd mto txJA d a1 a ejp1 ejp2 pandora color pt) (while (and (not para) (setq grd (grread nil 13 0)) (or (listp (cadr grd)) (= (car grd) 2))) (princ "\rMove the mouse to decide Justification and change Height, press < C > to change color, < + > or < - > to increase or decrease offset or press ESCAPE to cancel) ") (if (= (car grd) 2) (cond ((member (cadr grd) '(67 99)) (setq color (acad_colorDLG 1 T))) ((member (cadr grd) '(43 45)) ;|+ o -|; (vla-put-InsertionPoint (vlax-ename->vla-object mto) (vlax-3d-point (setq pt (polar (if pt pt pt1) ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) ((if (= (cadr grd) 43) + -) 0.1)))))) ) (progn (setq pt3 (cadr grd)) (setq SpotLevel (- ffl-value 0.15)) ;; Initialize point list ;; Prompt for points where to place the new MText (setq TxtRotation (angle pt1 pt2)) (setq TxtValue SpotLevel) (DefMTextJustification pt1 pt2 pt3) (if mto (if (/= TxtJustification txJA) (entmod (subst (cons 71 (setq txJA TxtJustification)) (assoc 71 (entget mto)) (entget mto))) ) (setq mto (CreateMText pt1 TxtValue TxtRotation (setq txJA TxtJustification)) a (cdr (assoc 40 (entget mto)))) ) (setq a (cdr (assoc 40 (entget mto))) ejp1 (polar pt1 ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) (/ a 2.)) ejp2 (polar pt2 ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) (/ a 2.)) ) (if (= (car grd) 3) (setq para T)) (cond ((> (setq d (distance (cadr grd) (setq ppp (inters ejp1 ejp2 (cadr grd) (polar (cadr grd) (+ (angle pt1 pt2) (/ PI 2.)) 1) nil)))) (* a (if pandora 1. 2.))) (setq d (/ d 2.) a1 (if (< (setq a1 (/ (fix (* d 10)) 10.)) 0.1) 0.1 a1) ) (entmod (append (entget mto) (if color (list (cons 40 a1) (cons 62 color)) (list (cons 40 a1))))) (setq pandora T) (princ (strcat " << Current Size: " (rtos a1 2 1) " >>")) ) (pandora (setq d (/ d 2.) a1 (if (< (setq a1 (/ (fix (* d 10)) 10.)) 0.1) 0.1 a1) ) (entmod (append (entget mto) (if color (list (cons 40 a1) (cons 62 color)) (list (cons 40 a1))))) (princ (strcat " << Current Size: " (rtos a1 2 1) " >>")) ) ) ) ) ) (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object))) ) (defun ExtractFFLValue (text-string / clean-text) (if (> (strlen text-string) 5) ;Charcters Removed from String (setq clean-text (substr text-string 6)) (setq clean-text text-string) ) (if (numberp (read clean-text)) (read clean-text) (progn (vlr-beep-reaction) (princ "\n*** ERROR : Could not extract numeric value from FFL text ***") nil ) ) ) (defun DefMTextJustification ( p1 p2 p3 / p) ;; Top Left = 1 ;; Top Center = 2 ;; Top Right = 3 ;; Middle Left = 4 ;; Middle Center = 5 ;; Middle Right = 6 ;; Bottom Left = 7 ;; Bottom Center = 8 ;; Bottom Right = 9 (setq p1 (polar p1 (angle p2 p1) 1e8)) (if (or (and (>= (angle p1 p2) 0.0) (<= (angle p1 p2) (/ PI 2.))) (>= (angle p1 p2) (/ (* 3. PI) 2.)) ) (progn (setq Prefix "+") (setq Suffix "") (if (= (asr p1 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (/ PI 2.)) 1) nil) p3) -) (setq TxtJustification 1) (setq TxtJustification 7) ) ) (progn (setq Prefix "") (setq Suffix "+") (setq TxtRotation (+ TxtRotation pi)) (if (= (asr p1 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (/ PI 2.)) 1) nil) p3) +) (setq TxtJustification 3) (setq TxtJustification 9) ) ) ) ) (defun CreateMText ( point txtvalue txtrot txtjust / txtjust txtrot mtext-obj) (setq mtext-obj (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 (getvar "CLAYER")) ; Current layer (cons 100 "AcDbMText") (cons 10 point) ; Insertion point (cons 40 0.5) ; Text height (adjust as needed) (cons 41 0.0) ; Reference rectangle width (cons 71 txtjust) (cons 72 5) ; Drawing direction (cons 1 (strcat Prefix (rtos txtvalue 2 3) Suffix)) ; Text content with "+" prefix (cons 50 txtrot) ; Rotation angle ) ) ) mtext-obj )

A relatively simple approach CivilTech.mp4

Consider the following function to obtain the data from the array: (defun LM:arraydata ( ent / enx lst rtn ) (if (and (setq enx (entget ent)) (= "INSERT" (cdr (assoc 0 enx))) (setq lst (vl-some (function (lambda ( x ) (if (and (= 330 (car x)) (= "ACDBASSOCDEPENDENCY" (cdr (assoc 0 (entget (cdr x)))))) (cdr (assoc 330 (entget (cdr x)))) ) ) ) (member '(102 . "{ACAD_REACTORS") enx) ) ) (setq lst (entget lst)) (setq lst (cons nil (member (assoc 1 lst) lst))) ) (while lst (setq rtn (cons (cons (cdadr lst) (cdar (cddddr lst))) rtn) lst (cdddr (cddddr lst)) ) ) ) (reverse rtn) ) Call with the array block reference entity, e.g.: (LM:arraydata (car (entsel)))

If you inspect the DXF data for a rectangular array (e.g. using my Entity List program, for example), you will see that it is in fact a block reference (INSERT).

Good afternoon, everyone. I am trying to select a arrayrect and insert a TEXT with the number of array elements into the drawing. But the array is not selected. How do I set the array selection correctly? (defun c:CountElemArrayrect (/ ss n pt) (princ "Select a arrayrect: ") (setq ss (ssget '((0 . "ARRAY"))) n 0) (if ss (progn (setq n (vla-get-Count (vlax-ename->vla-object (ssname ss 0)))) (princ (strcat "The number of elements in the array: " (itoa n))) (princ "Specify the insertion point of the text: ") (setq pt (getpoint)) (if pt (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 1 (itoa n)) (cons 40 25) ; text height (cons 7 (getvar "TEXTSTYLE")) ) ) ) ) ) (princ) )

Thanks you all @mhupp @BIGAL @SLW210

Thank you all. When I found the LM solution I abandoned the post...

That isn't complete code it's just a layout of what to do. You had the getcoords function in your original post. -edit You can see this post to pull cords from an polyline without its own function https://www.cadtutor.net/forum/topic/76319-add-block-onto-polyline-vertices/#findComment-603350 (setq PTLST1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget PL1))))

Hi mhupp. Thanks for the code , but I use Zwcad and get this Error: undefined function - GETCOORDS Thanks

Thanks. I found a work-around. Not sure what caused it.

Get you going on what StevenP and BigAL are talking about. (defun _option1 (/ SS SSPTZ SSVER PL1 PL2 PTlst1 PTlst2) (princ "\nSelect Base Polyline: ") (setq SS (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))) ;emulates entselect only allowing you to select one entity at a time. PL1 (ssname ss 0) ) (princ "\nSelect Polyline to Check against: ") (setq SS (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))) PL2 (ssname ss 0) ) (if (and PL1 PL2) ; if both polylines are selected build cords (setq PTLST1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget PL1))) PTLST2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget PL2))) ) (progn ;else prompt the user and rerun the command. (prompt "\nyou need to Select two Polylines for this command") (_option1) (exit) ) ) (foreach PT PTLST1 ;insert polyline block with "*" infront this will explode into a polyline ;add polylione to selection set SSVER ) (foreach PT PTLST2 ;add point to each vertex ;add point to SSPTZ selection set ) (foreach check SSVER ;use getcoords on Polyline and save as checkpts ;feed that into (ssget "_WP" checkpts '((0 . "POINT"))) ;check if only 1 point is found ;if yes delete polyline and point ;if no skip polyline ) (if (> (sslength SSPTZ) 0) ;points left are outside fuzz distance between poly1 and poly2 vertex (foreach PT SSPTZ ;delete pt and grdraw X at location ) ) (if (> (sslength SSVER) 0) ;if any polylnes are left a point wasn't found inside it. (progn (setq f (sslength SSVER)) (prompt (strcat "\n " f "Fertex(s) found on poly1 not matching Poly2") ) ) (princ "\nCheck Complete !!.") (princ) ) -edit removed getcoords function.

You will need to post the .dwg.

One step further could be to increase or decrease the size of the MTEXT objects. This could be done dynamically, giving meaning to the cursor movement: when it moves in a certain direction, it not only determines the justification but also, as it moves farther away, it gradually increases the size step by step. In my opinion, this is an interesting idea that deserves to be explored.

Thanks @BIGAL working fine now.

Not sure why the code was posted that way 2 typos. (defun c:ellpl ( / lwpoly obj oldsnap num inc dist plst pt) (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst)))) (setq obj (vlax-ename->vla-object (car (entsel "\nPick ellipse ")))) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq num 100) (setq inc (/ (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) num) dist 0.0 plst '() ) (repeat (+ num 1) (setq pt (vlax-curve-getpointatdist obj dist)) (setq plst (cons pt plst)) (setq dist (+ dist Inc)) ) (LWPoly plst 1) (setvar 'osmode oldsnap ) (princ) )

@CivilTechSource It's easy to do that. I have make a more robust filter for mtext (with your exemple, adjust if necessary) (defun q_ang (alpha / ) (cond ((not (eq (rem alpha (* 1.5 pi)) alpha)) 4) ((not (eq (rem alpha pi) alpha)) 3) ((not (eq (rem alpha (* 0.5 pi)) alpha)) 2) (T 1) ) ) (defun c:wow ( / ss ent dxf_ent ptlst n pt_cen dir_ang tmp ofst n rot) (princ "\nSelect closed polylines") (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1)))) (cond (ss (initget 4) (setq ent (ssname ss 0) dxf_ent (entget ent) ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)) n (float (length ptlst)) pt_cen (list (/ (apply '+ (mapcar 'car ptlst)) n) (/ (apply '+ (mapcar 'cadr ptlst)) n)) dir_ang (mapcar 'q_ang (mapcar '(lambda (x) (angle pt_cen x)) ptlst)) tmp (* (distance pt_cen (car ptlst)) 0.25) ofst (getdist (car ptlst) (strcat "\nOffset for text <" (rtos (getvar "TEXTSIZE")) ">?: ")) ) (if (not ofst) (setq ofst (getvar "TEXTSIZE"))) (mapcar '(lambda (p d / j po) (setq qsel (ssget "_C" (mapcar '- p (list tmp tmp 0.0)) (mapcar '+ p (list tmp tmp 0.0)) '((0 . "MTEXT") (8 . "-LE-E-External Levels") (7 . "LE Standard (No Height)")))) (cond (qsel (repeat (setq n (sslength qsel)) (setq ent (ssname qsel (setq n (1- n))) dxf_ent (entget ent) rot (cdr (assoc 50 dxf_ent)) ) (if (eq d 1) (if (zerop rot) (setq j 9 po (polar p (* 0.5 pi) ofst)) (setq j 7 po (polar p 0.0 ofst)))) (if (eq d 2) (if (zerop rot) (setq j 7 po (polar p (* 0.5 pi) ofst)) (setq j 1 po (polar p pi ofst)))) (if (eq d 3) (if (zerop rot) (setq j 1 po (polar p (* 1.5 pi) ofst)) (setq j 7 po (polar p pi ofst)))) (if (eq d 4) (if (zerop rot) (setq j 3 po (polar p (* 1.5 pi) ofst)) (setq j 1 po (polar p 0.0 ofst)))) (setq dxf_ent (subst (cons 10 po) (assoc 10 dxf_ent) dxf_ent)) (setq dxf_ent (subst (cons 71 j) (assoc 71 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) ) ptlst dir_ang ) ) ) (prin1) )