to find text, first number and last number, and create line

[cepsoe12]

[Tharwat]

Your texts have to be single texts to be able to select them and besides that they should end with digit.

 

(defun c:Test (/ int sel ent get lst)
  ;; Tharwat - Date: 26.Feb.2022	;;
  (and
    (princ "\nSelect single texts : ")
    (setq int -1 sel (ssget '((0 . "TEXT") (1 . "*#"))))
    (or (< 1 (sslength sel))
        (alert "Must select two texts at least to continue <!>")
    )
    (while (setq int (1+ int) ent (ssname sel int))
      (setq get (entget ent)
            lst (cons (list (atoi (substr (cdr (assoc 1 get)) 2))
                            (cdr (assoc 10 get))
                      )
                      lst
                )
      )
    )
    (entmake
      (list
        '(0 . "LINE")
        (cons 10 (cadar (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))))
        (cons 11 (cadar (reverse lst)))
      )
    )
  )
  (princ)
) (vl-load-com)

 

[cepsoe12]

 

it worked, thank you

[Tharwat]

23 minutes ago, cepsoe12 said:

 

it worked, thank you

You're welcome anytime.  

[tuantrinhdp]

11 hours ago, Tharwat said:

Your texts have to be single texts to be able to select them and besides that they should end with digit.

 

(defun c:Test (/ int sel ent get lst)
  ;; Tharwat - Date: 26.Feb.2022	;;
  (and
    (princ "\nSelect single texts : ")
    (setq int -1 sel (ssget '((0 . "TEXT") (1 . "*#"))))
    (or (< 1 (sslength sel))
        (alert "Must select two texts at least to continue <!>")
    )
    (while (setq int (1+ int) ent (ssname sel int))
      (setq get (entget ent)
            lst (cons (list (atoi (substr (cdr (assoc 1 get)) 2))
                            (cdr (assoc 10 get))
                      )
                      lst
                )
      )
    )
    (entmake
      (list
        '(0 . "LINE")
        (cons 10 (cadar (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))))
        (cons 11 (cadar (reverse lst)))
      )
    )
  )
  (princ)
) (vl-load-com)

 

Can you help me a problem? I have text 6.55,6.56,6.57,... and i want to draw polyine when i select each text. 
ex: i choose 6.57 - 6.58 - 6.59 - 6.65 - 6.64 - 6.60

test.dwg

[BIGAL]

Dont need code just set osnap to Insertion only. 

[mhupp]

;;----------------------------------------------------------------------------;;
;; DRAW POLYLINE IN NUMERICAL ORDER
(defun c:Foo (/ SS lst)
  (if (and (setq SS (ssget '((0 . "TEXT") (1 . "*#")))) (> (sslength SS) 1))  ;Tharwat
    (progn
      (setq lst (mapcar '(lambda (x) (list (cdr (assoc 1 (entget x))) (cdr (assoc 11 (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
      (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
      (entmake
        (append
          (list '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                (cons 90 (length lst))
                '(70 . 0)
          )
          (mapcar '(lambda (x) (cons 10 (cadr x))) lst)
        )
      )
    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

 

Edited February 27, 2022 by mhupp
updated code to entmake

[tuantrinhdp]

5 hours ago, mhupp said:

If you wanted to draw a line in order (6.57, 6.58, 6.59, 6.60, 6.64, 6.65) use this.

 

;;----------------------------------------------------------------------------;;
;; DRAW POLYLINE IN NUMERICAL ORDER
(defun c:Foo (/ SS lst)
  (if (and (setq SS (ssget '((0 . "TEXT") (1 . "*#")))) (> (sslength SS) 1)) ;Tharwat
    (progn
      (setq lst (mapcar '(lambda (x) (list (cdr (assoc 1 (entget x))) (assoc 10 (entget x)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
      (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
      (vl-cmdf "_.Polyline")
      (foreach pt lst
        (vl-cmdf (cadr pt))
      )
      (vl-cmdf "")
    )
    (prompt "\nNothing Selected")
  )
  (princ)

 

Not understanding your route. its not in order, to the next closest (6.57 is closer to 6.60), or the shortest length.

if that is what you want follow what BIGAL posted.

I tried but not success, error: "Application ERROR: Invalid type sent as command input"

[mhupp]

The code worked in BricsCAD. after googling error message seems to be a vl-cmdf and probably could have just changed to "command" but i don't know. updated to entmake  to avoid using command or vl-cmdf altogether. that's usually the best bet.

Edited February 27, 2022 by mhupp

[Tharwat]

10 hours ago, tuantrinhdp said:

Can you help me a problem? I have text 6.55,6.56,6.57,... and i want to draw polyine when i select each text. 
ex: i choose 6.57 - 6.58 - 6.59 - 6.65 - 6.64 - 6.60

Try this.

(defun c:Test (/ int sel ent get lst)
  ;; Tharwat - Date: 27.Feb.2022	;;
  (and
    (princ "\nSelect single texts : ")
    (setq int -1
          sel (ssget '((0 . "TEXT") (1 . "*#")))
    )
    (or (< 1 (sslength sel))
        (alert "Must select two texts at least to continue <!>")
    )
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (setq get (entget ent)
            lst (cons (list (read (cdr (assoc 1 get)))
                            (cdr (assoc 10 get))
                      )
                      lst
                )
      )
    )
    (entmake
      (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
                    (cons 90 (length lst)) '(70 . 0)
              )
              (mapcar (function (lambda (p) (cons 10 (cadr p))))
                      (vl-sort lst '(lambda (j k) (< (car j) (car k))))
              )
      )
    )
  )
  (princ)
) (vl-load-com)

 

Edited February 27, 2022 by Tharwat

[tuantrinhdp]

25 minutes ago, Tharwat said:

Try this.

(defun c:Test (/ int sel ent get lst)
  ;; Tharwat - Date: 27.Feb.2022	;;
  (and
    (princ "\nSelect single texts : ")
    (setq int -1
          sel (ssget '((0 . "TEXT") (1 . "*#")))
    )
    (or (< 1 (sslength sel))
        (alert "Must select two texts at least to continue <!>")
    )
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (setq get (entget ent)
            lst (cons (list (read (cdr (assoc 1 get)))
                            (cdr (assoc 10 get))
                      )
                      lst
                )
      )
    )
    (entmake
      (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
                    (cons 90 (length lst)) '(70 . 0)
              )
              (mapcar (function (lambda (p) (cons 10 (cadr p))))
                      (vl-sort lst '(lambda (j k) (< (car j) (car k))))
              )
      )
    )
  )
  (princ)
) (vl-load-com)

 

Thanks. 
My drawing use text justify CENTER, can help me add code draw polyline by justify text?

Edited February 27, 2022 by tuantrinhdp

[Tharwat]

What do you mean by polyline by justify ?

[tuantrinhdp]

Edited February 27, 2022 by tuantrinhdp

[marko_ribar]

@mhupp,

Just a small remark - for future better practice (challenges) :

 

This line :

(setq lst (mapcar '(lambda (x) (list (cdr (assoc 1 (entget x))) (cdr (assoc 10 (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))

 

Consider :

(setq lst (mapcar '(lambda (x / enx) (list (cdr (assoc 1 (setq enx (entget x)))) (cdr (assoc 10 enx)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))

 

Your verison does the same, but it' not 100% efficient... Tharwat is doint the same, but he is smartly avoiding getting DXF data twice (or more times)... In essence (entget) function calls that are unnecessary should be avoided as much as possible... The same is with (ssnamex) and perhaps with (nth) in comparison with (cdr), (car), (cadr), ... And from my experience, also when coding, try to avoid (member) function over (vl-position)... (member) will do it if you want to test presence of element in a list, but it is also getting you all elements reminders - outpur/return is also list, just truncated; in other hand (vl-position) will just return you integer number representing element position in checking list, thus much, much more faster - i.e. (if it returns number, than element belongs to list, and if it's nil not)... Here, just for better understanding - in many situations, you'll have to find presence of element in a list, but not with exact matching of values - for ex. point (10.0 10.0 10.0) belongs to list ((10.0 10.0 10.0) (10.1 10.1 10.1) ... ), but you obtained point with picking "nea" OSNAP near vertex (10.0 10.0 10.0) of a BOX [(0.0 0.0 0.0) (10.0 10.0 10.0)]... Now you need to find if point belongs to list : sometimes (member pt lst) => nil, and also (vl-position pt lst) => nil ;... Then what's the trick!!!

Well, to overcome this cases, you just have to use different ones that do the same similar :

1. (member) ... => (vl-member-if)

2. (vl-position) ... => (vl-some)

Here is how :

1. (vl-member-if '(lambda ( x ) (equal x pt fuzz)) lst) ;;; fuzz (1e-6) ;;; but like I stated - (vl-member-if) will yield you also a truncated list just like (member)...

So as opposed to this in search for efficiency, the best approach is :

2. (vl-some '(lambda ( x ) (equal x pt fuzz)) lst)

 

Those are just a few tricks for you to consider... In some occaisons, you may stumble at situation where you should use multiple (vl-some) calls nested in each other - nested iterations/recursions... And to get the fastest looping terminations with resulting outcomes (checked element - obtained), you'll see that (vl-some) has very justified appliance...

 

To get element from list by using (vl-some), just use this snippet :

(vl-some '(lambda ( x ) (if (equal x pt fuzz) x)) lst) ;;; here x element from lst was returned opposed to checking reference element pt - also fuzz factor is involved for better comparison operations...

Note that [else] statement from (if) is nil - forcing (vl-some) to continue with checking iterations all the way until complete lst was processed... If no matching found (vl-some) retuns nil also, but if (vl-some) detects matching, then result is that element X, and termination occurs imidiately when matching happened - that means if lst = (x a b c d ... ), and you apply (vl-some), you'll get X in 0.00001 millisecond, but if you have lst = (a1 a2 a3 ... a9999999 a10000000 x), (vl-some) would have to do checkings all the way until it gets X - last one... So in this and similar cases, you'll have to give appropriate feeding instruction to (vl-some), i.e. you should (reverse) lst beforehand : (setq lst (reverse lst))...

 

 

Edited February 27, 2022 by marko_ribar

[mhupp]

Yes I am aware. still newish to lambda and mapcar so trying to use it as much as possible to understand it better. thank you for the advice. also i prefer to use ssnamex over (ssname SS i) just seem cleaner to me.

 

I use distance when checking points. if one element doesn't has z cords like a LWPolyline and the other dose like most everything else it will come up nil with the equal function. Even if they are on the same elevation.

(vl-some '(lambda (x) (if (< (distance x pt) fuzz)x)) lst)

 

[BIGAL]

Try this, version 2 would be draw temporary pline as you go. 

 

; join text objects by mid point

(defun getllur (ent / obj pointmin pointmax)
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
(mapcar '* (mapcar '+ pointmin pointmax) '(0.5 0.5 0.5))
)

(defun c:joinobjects ( / lst ent1 ent2 pt1 ent1 mp)
(setq lst '())

(setq oldsnap (getvar 'osmode))
(setq ent1 (entsel "\nSelect 1st text "))
(setq pt1 (cdr (assoc 10 (entget (car ent1)))))
(setq mp (getllur (car ent1)))
(setq lst (cons mp lst))

(setvar 'osmode 512)

(while (setq pt2 (getpoint pt1 "\nSelect next text Enter to exit "))
(setq ent1 (ssname (ssget pt2 '((0 . "*TEXT"))) 0))
(setq mp (getllur ent1))
(setq lst (cons mp lst))
(setq pt1 pt2)
)

(entmake
        (append
          (list '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                (cons 90 (length lst))
                '(70 . 0)
          )
          (mapcar '(lambda (x) (cons 10 x)) lst)
        )
)
(princ)
)

(c:joinobjects)