Adjust loop to look like MLINE

[adaptacad]

Hello people.
I found this code in internet searches and I'm trying to modify it for my operation, but due to little experience I can't.
how can I modify it so that the code has the same function but does not have the corners like this (photo below) similar to the MLINE command but with the texts

(defun c:TEST ( / slc pti ptn ptc ang mid ptn inf  tmp dis num idx stp ent )
  ;;++++++++++++++++++++++++++++++++++++++++++++++++++++;;
  (defun *error* ( msg )
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " msg))
    )
    (command-s "_.Undo" "_End")
    (princ)
  )
  (command-s "_.Undo" "_Begin")  
  (initget 128 "Width")
  (setq rtr (vl-catch-all-apply 'getpoint (list "\nClick on the starting point or [Width] ")))
  (if (= (type rtr) 'vl-catch-all-apply-error)
    (progn 
      (alert (strcat "Error: " (vl-catch-all-error-message rtr)))
      (exit)
    )
    (cond
      ( (= rtr nil)
        (alert "ERROR: \nNo point was chosen.")
        (exit)
      )
      ( (= (type rtr) 'LIST)
        (setq pti rtr)
      )
      ( (= (type rtr) 'STR)
        (if (setq lar (getdist (strcat "\nWidth <" (rtos (getvar 'cmlscale) 2 2) ">: ")))
          (setq scl (setvar 'cmlscale lar))
        )
        (setq pti (getpoint "\nClick the starting point:"))
      )
    )
  )
  (while t
    (setq ptn (getpoint pti "\nClick next point: "))
    (setq ang (angle pti ptn)
          mid (polar (mapcar (function (lambda (x y) (/ (+ x y) 2.0))) pti ptn) 5.0 (/ scl 2.0))
    )
    (setq id "ID: XXXX")
    (if (and (> ang (/ pi 2)) (< ang (* 1.5 pi)))
      (setq ang (+ ang pi))
    )
    (setq dis (distance pti ptn))
    (cond
      ( (< 0 dis 80   ) (setq num 0))
      ( (< 80 dis 200 ) (setq num 1))
      ( (< 200 dis 400) (setq num 2))
      ( (< 400 dis 800) (setq num 3))
      ( (< 800) (setq num 4))
    )
    (setq stp (/ dis (+ num 1)))
    (setq idx 1 )
    (repeat num
      (setq ptc (polar pti (angle pti ptn) (* idx stp)))
      (setq ptc (polar ptc (- (angle pti ptn) (/ pi 2)) (/ scl 2.0)))
      (vl-cmdf "_.Text" "_Justify" "_MC" ptc 2.5 (/ (* ang 180.0) pi) id )
      (setq idx (1+ idx))
    )
    (vl-cmdf "_.Mline" pti ptn "")
    (if (not (eq ent (setq ent (entlast))))
      (vl-cmdf "_.explode" ent)
    )
    (setq pti (getvar 'lastpoint))
  );aqui while
  (command-s "_.Undo" "_End")
  (princ)
)

[Kent1Cooper]

---

@adaptacad wrote:

....
how can I modify it so that the code has the same function but does not have the corners like this (photo below) similar to the MLINE command but with the texts

---

That would need a really substantial re-write, given that the way it works is [if I understand correctly with only a quick perusal] to draw individual one-segment MLINEs and label each along with drawing it.  If it were to draw the whole series as one MLINE, the corners would be "clean," but then it couldn't put in the text as it goes -- it would need to do something like let you finish the MLINE and then go back and figure out where to put all the text elements.  That would involve a lot more code to differentiate segments, locate text insertion points, etc.  Is that a User procedure that you can work with?

As an aside, I noticed something that could be a problem:

    (cond
      ( (< 0 dis 80   ) (setq num 0))
      ( (< 80 dis 200 ) (setq num 1))
      ( (< 200 dis 400) (setq num 2))
      ( (< 400 dis 800) (setq num 3))
      ( (< 800) (setq num 4))
    )

[First, I think  (< 800)  would be more logically  (< 800 dis) , though as it is it will "work" because  (< anything)  , without another argument to compare to, always returns T, even if 'anything' is not numerical, or even nil.  It could also be replaced with just T, or the test omitted altogether, and it will just do the setting.  But back to the subject:]  If a segment is exactly 80 units long, or 200 or 400 or 800, it won't fall into any of those test ranges, so 'num' will not be set [or, will always be set to 4, if you leave that last condition as is -- I don't think you want it set to 4 for a length of 80].  If the first condition failed, you've already covered all distances up to [but not including] 80, so you don't need the 80 argument in the second condition's test.  I think it should be more like:

    (cond
      ((< 0 dis 80) (setq num 0))
      ((< dis 200) (setq num 1))
      ((< dis 400) (setq num 2))
      ((< dis 800) (setq num 3))
      ((setq num 4)); none-of-the-above [it's 800 or longer]
    )

[hak_vz]

Check if you like my solution that utilizes OFFSET command on LWPOLYLINE

Create one or more polylines - left or right side of double line object and run command PWLT

it will offset each lwpolyline for required distance to desired side and create a text in the middle of each segment.

(defun c:plwt ( / *error* take vectorSide ts th e tc p1 p2 p3 side tc a b c segments width)
(defun *error* ( msg )
	(vla-endundomark adoc)
	(setvar 'cmdecho 1)
	(if (not (member msg '("Function cancelled" "quit / exit abort")))
		(princ (strcat "\nError: " msg))
	)
	(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun vectorSide (v1 v2 p / r *fuzz*)
	(setq r (- (* (-(car v2)(car v1))(-(cadr p)(cadr v1)))
			   (* (-(cadr v2)(cadr v1))(-(car p)(car v1)))
			)
		*fuzz* 1e-10
	)
(cond ((equal r 0.0 *fuzz*) 0) (t (fix (/ (abs r) r))))
)

(setq ts (getstring "\nEnter repeating text >" T))
(setq width (getreal "\nEnter width of mline >"))
(setq th (getreal "\nEnter text heigth >"))
(while (setq e (entsel "\n Select polyline to offset from >"))
	(setq e (car e))
	(command "_.offset" width e)
	(while (> (getvar "cmdactive") 0) (command pause))
	(setq p1 (vlax-curve-getstartpoint (vlax-ename->vla-object e)) p3 (vlax-curve-getstartpoint (vlax-ename->vla-object (entlast))))
	(cond 
		((vlax-property-available-p (vlax-ename->vla-object e) 'Coordinates)
			(setq tc (vlax-get (vlax-ename->vla-object e) 'Coordinates))
			(setq p2 (take 2 (cddr tc)))
			(setq side (vectorSide p1 p2 p3))
			(while (> (length tc) 2) (setq a (take 2 tc) tc (cddr tc) b (take 2 tc) segments (cons (list a b) segments)))
			(setq segments (reverse segments))
			(foreach seg segments
				(setq a (car seg) b (cadr seg))
				(if (< side 1) 
					(setq c (polar (mapcar '* (mapcar '+ a b) (list 0.5 0.5)) (- (angle a b) (/ pi 2)) (* 0.5 width)))
					(setq c (polar (mapcar '* (mapcar '+ a b) (list 0.5 0.5)) (+ (angle a b) (/ pi 2)) (* 0.5 width)))
				)
				(entmakex (list (cons 0 "TEXT")(cons 100 "(AcDbText") (cons 10 c) (cons 40 th) (cons 50 (angle a b)) (cons 1 ts)))
			)
	))

)
(princ)
)

[ronjonp]

As Kent stated this pretty much requires a rewrite. Also you don't need to have a bunch of nested setq's in the COND statement .. it could be refactored like so:

(setq num (cond	((< 0 dis 80) 0)
		((< dis 200) 1)
		((< dis 400) 2)
		((< dis 800) 3)
		(4)
	  )
)

[adaptacad]

@Kent1Cooper  thanks for the reply, I didn't know it would be so hard to make this change.

[adaptacad]

@hak_vz thanks for the reply, Unfortunately your code doesn't work as I expected, doing this I will have to do the process twice and it takes longer.

[adaptacad]

@ronjonp  thanks for the tip, I will check.

[adaptacad]

I saw that in this link the person in charge used this method.
but my knowledge doesn't allow editing to make it functional.

(vl-cmdf "_.mline")

  (while (= 1 (logand 1 (getvar 'cmdactive)))

    (vl-cmdf "\\")

 )

[Kent1Cooper]

---

@adaptacad wrote:

....

(vl-cmdf "_.mline")

  (while (= 1 (logand 1 (getvar 'cmdactive)))

    (vl-cmdf "\\")

 )

---

That's a way of starting a command, and as long as it hasn't been ended yet, continuing to wait for User input, with an indeterminate number of inputs, and only after the command is completed, moving on to the next thing.  Read about the CMDACTIVE System Variable in Help.  It's checking whether the CMDACTIVE value includes the 1 bit that means a command is active.  But I don't think it's necessary to check for the 1 bit -- any value greater than 0 is sufficient to indicate that the command is still running.  Another common way to do the same thing:

(command "_.mline")

(while (> (getvar 'cmdactive) 0) (command pause))

But in recent versions [something like 2015 & later, I think?] there's an even simpler way:

(command-s "_.mline")

[The description of (command-s) in Help doesn't sound to me like it should work that way, but apparently it does.]

That would be for drawing the whole MLINE first, after which it would need to go back to do the text parts.

[marko_ribar · Accepted solution]

---

@adaptacad wrote:

I saw that in this link the person in charge used this method.
but my knowledge doesn't allow editing to make it functional.

(vl-cmdf "_.mline")

  (while (= 1 (logand 1 (getvar 'cmdactive)))

    (vl-cmdf "\\")

 )

---

Here, I ammended your code, give this a try...

(defun c:MyMline ( / rtr lar scl pti ptn pl ang id dis num ptc idx stp el )

  (defun *error* ( msg )
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " msg))
    )
    (command-s "_.Undo" "_End")
    (princ)
  )

  (command-s "_.Undo" "_Begin")  
  (initget 128 "Width")
  (setq rtr (vl-catch-all-apply 'getpoint (list "\nClick on the starting point or [Width] : ")))
  (if (= (type rtr) 'vl-catch-all-apply-error)
    (progn 
      (alert (strcat "Error: " (vl-catch-all-error-message rtr)))
      (exit)
    )
    (cond
      ( (= rtr nil)
        (alert "ERROR: \nNo point was chosen.")
        (exit)
      )
      ( (= (type rtr) 'LIST)
        (setq pti rtr)
      )
      ( (= (type rtr) 'STR)
        (if (setq lar (getdist (strcat "\nWidth <" (rtos (getvar 'cmlscale) 2 2) ">: ")))
          (progn
            (setvar 'cmlscale lar)
            (setq scl lar)
          )
        )
        (setq pti (getpoint "\nClick the starting point: "))
      )
    )
  )
  (setq el (entlast))
  (if (null scl)
    (setq scl (getvar 'cmlscale))
  )
  (setq pl (cons pti pl))
  (vl-cmdf "_.Mline" "_non" pti)
  (while (< 0 (getvar 'cmdactive))
    (prompt "\nClick next point (ENTER - FINISH or C - Close FINISH): ")
    (vl-cmdf "_non" "\\")
    (if (not (equal (car pl) (getvar 'lastpoint)))
      (setq pl (cons (getvar 'lastpoint) pl))
    )
  )
  (if (and (not (eq el (entlast))) (= 2 (logand 2 (cdr (assoc 71 (entget (entlast)))))))
    (setq pl (cons (last pl) pl))
  )
  (setq pl (reverse pl))
  (setq pl (mapcar '(lambda ( a b ) (list a b)) pl (cdr pl)))
  (repeat (length pl)
    (setq pti (caar pl))
    (setq ptn (cadar pl))
    (setq ang (angle pti ptn))
    (setq id "ID: XXXX")
    (if (and (> ang (/ pi 2)) (< ang (* 1.5 pi)))
      (setq ang (+ ang pi))
    )
    (setq dis (distance pti ptn))
    (cond
      ( (< dis 80) (setq num 0) )
      ( (< dis 200) (setq num 1) )
      ( (< dis 400) (setq num 2) )
      ( (< dis 800) (setq num 3) )
      ( (t (setq num 4)) )
    )
    (setq stp (/ dis (+ num 1)))
    (setq idx 1)
    (repeat num
      (setq ptc (polar pti (angle pti ptn) (* idx stp)))
      (setq ptc (polar ptc (- (angle pti ptn) (/ pi 2)) (/ scl 2.0)))
      (vl-cmdf "_.Text" "_Justify" "_MC" "_non" ptc 2.5 (/ (* ang 180.0) pi) id)
      (setq idx (1+ idx))
    )
    (setq pl (cdr pl))
  )
  (command-s "_.Undo" "_End")
  (princ)
)

[adaptacad]

thanks @marko_ribar  it was exactly that !!!