All Activity

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) )

I'm getting this error Command: ; error: malformed list on input I also found this online. but it's converting the ellipse into full circle. This is working fine before. ;Tip1539A: EL2PL.LSP Ellipse to Pline (c)1999, Oleg Khenson (defun C:EL2PL (/ A CEN CLA CMD DIS EN END_P1 END_P2 ENT I K LA LT M MINOR% NM OLDERR OS PELMODE SS ) (defun DXF (CODE ELIST) (cdr (assoc CODE ELIST))) (defun EL2PL_ERR (S) (if (/= S "Function cancelled") (princ (strcat "\nError: " S)) ) (setvar "CMDECHO" CMD) (if OS (setvar "OSMODE" OS) ) (setq *ERROR* OLDERR OLDERR NIL ) (princ) ) (setq OLDERR *ERROR* *ERROR* EL2PL_ERR ) (setq CMD (getvar "CMDECHO")) (setvar "CMDECHO" 0) (princ "\nSelect Ellipses to be converted to PLines: ") (setq SS (ssget '((0 . "ELLIPSE")))) (command ".UNDO" "G") (if SS (progn (setq OS (getvar "OSMODE")) (setvar "OSMODE" 0) (setq I 0 K 0 M 0 ) (repeat (sslength SS) ; for each entity from SS (setq A (entget (setq NM (ssname SS I) ENT NM ) ) LA (DXF 8 A) ) (if (< (cdr (assoc 70 (tblsearch "LAYER" LA))) 4) (progn (if (= (DXF 0 A) "ELLIPSE") (progn (setq LT (DXF 6 A) CEN (DXF 10 A) MINOR% (DXF 40 A) END_P1 (mapcar '+ CEN (DXF 11 A)) DIS (distance CEN END_P1) END_P2 (polar CEN (+ (angle CEN END_P1) (/ pi 2.0)) (* DIS MINOR%) ) ) (setq PELMODE (getvar "PELLIPSE")) (setvar "PELLIPSE" 1) (setq CLA (getvar "CLAYER")) (if (/= CLA LA) (setvar "CLAYER" LA) ) (command ".ELLIPSE" "C" (trans CEN 0 1) (trans END_P1 0 1) (trans END_P2 0 1) ) (setq K (1+ K)) (setvar "PELLIPSE" PELMODE) (entdel ENT) (if (/= CLA (getvar "CLAYER")) (setvar "CLAYER" CLA) ) (if (and LT (/= (DXF 6 (tblsearch "LAYER" LA)) LT) ) (progn (command ".CHPROP" "L" "" "LT" LT "") (command ".PEDIT" "L" "L" "ON" "") ) ) ) ) ) (setq M (1+ M)) ) (setq I (1+ I)) ) (if (> M 0) (princ (strcat "\n" (itoa M) (if (= M 1) " ELLIPSE was" " ELLIPSEs were" ) " on locked layer" (if (= M 1) "." "(s)." ) ) ) ) (if (> K 0) (princ (strcat "\n" (itoa K) " ELLIPSE" (if (= K 1) " was" "s were" ) " successfully converted to PLINE" (if (= K 1) "." "s." ) ) ) ) ) ) (setq *ERROR* OLDERR) (command ".UNDO" "E") (if OS (setvar "OSMODE" OS) ) (setvar "CMDECHO" CMD) (princ) )

@Tsuky (/ (* 3 pi) 2) (* 1.5 pi) (* 0.25 pi) and so on. @CivilTechSource have you looked at my Multi getvals.lsp it will make a dcl on the fly for you for input of offset values, can set defaults . Look in downloads.

Just throwing ideas around, take the base Pline, get vertices then search for objects withing a polygon shape say 8 sides, then compare points find a point within say the desired tolerance and move that point within the other pline. In dwg can see two plines at one location so like @Steven P need a loop to check more than 1 pline meeting at a point. Then pick another base pline and repeat. No time for coding the next few days.

I suppose the next to improve it is add offset, or a settings menu?

I haven't had chance to look through this fully, but it looks like you have a few loops in there - with more and more polylines it might star to really slow down. Interesting problem to think about maybe tomorrow