Add a word in the middle of the selected rectangle

[yxl030]

Can someone write a lisp for me?
To add a word in the middle of all the rectangles  selected.

Same font size，like the jpg.

Thanks. 

 

[ronjonp]

Why not use a block with an attribute for this?

[maratovich]

I did it!
Everything corresponds to the terms of reference - add a word in the middle of all selected rectangles
And the genius in Paint

But seriously:

1. You need to attach a sample dwg file

2. The forum helps, and does not just do it for everyone. You must try to make the Lisp yourself and you will be corrected and helped.

[BIGAL]

Try this has a homework attached google text readable hint lee-mac.

 

; simple text at mid of rectang alanh AUG 2021

(defun c:wow ( / rec co-ord p1 p2 p3 and d1 d2)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(while (setq rec (entsel "\npick rectang Enter to exit"))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec)))))
(setq p1 (nth 0 co-ord)
      p2 (nth 1 co-ord)
      p3 (nth 2 co-ord)
)
(setq d1 (distance p1 p2)
      d2 (distance p2 p3)
)
(setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)))
(if (> d1 d2)
(setq ang (angle p1 p2))
(setq ang (angle p2 p3))
)
(command "text" mp 2.5 ang "abc")
)
(setvar 'aunits (oldang))
(princ)
)

 

[yxl030]

16 hours ago, ronjonp said:

Why not use a block with an attribute for this?

Thank you .Sometimes the rectangle already exists.

 

[yxl030]

13 hours ago, maratovich said:

I did it!
Everything corresponds to the terms of reference - add a word in the middle of all selected rectangles
And the genius in Paint

But seriously:

1. You need to attach a sample dwg file

2. The forum helps, and does not just do it for everyone. You must try to make the Lisp yourself and you will be corrected and helped.

I don't know LISP, and even have trouble reading it.

[yxl030]

4 hours ago, BIGAL said:

Try this has a homework attached google text readable hint lee-mac.

 

; simple text at mid of rectang alanh AUG 2021

(defun c:wow ( / rec co-ord p1 p2 p3 and d1 d2)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(while (setq rec (entsel "\npick rectang Enter to exit"))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec)))))
(setq p1 (nth 0 co-ord)
      p2 (nth 1 co-ord)
      p3 (nth 2 co-ord)
)
(setq d1 (distance p1 p2)
      d2 (distance p2 p3)
)
(setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)))
(if (> d1 d2)
(setq ang (angle p1 p2))
(setq ang (angle p2 p3))
)
(command "text" mp 2.5 ang "abc")
)
(setvar 'aunits (oldang))
(princ)
)

 

Thank you BIGAL！That's what I want，Thanks.

But, how can I modify the code to select more than one rectangle at a time?

[BIGAL]

Your home work look up using (setq ss (SSGET then a (Repeat (sslength ss) its very simple change to code. Just look at some of the code supplied here.

Edited August 25, 2021 by BIGAL

[yxl030]

I did my homework all afternoon and still failed.

CAD says:

Error: Parameter type error: consp #<VLA-OBJECT IAcadLWPolyline 000000003c3d77b8>

;https://www.cadtutor.net/forum/topic/73614-add-a-word-in-the-middle-of-the-selected-rectangle/
; simple text at mid of rectang alanh AUG 2021

(defun C:wow(/ rec co-ord p1 p2 p3 and d1 d2)
(vl-load-com)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(setq i 0)
(setq ent (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
(if ent
    (repeat (sslength ent)
    (setq rec (vlax-ename->vla-object (ssname ent i)))
;(while (setq rec (entsel "\npick rectang Enter to exit"))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec)))))
(setq p1 (nth 0 co-ord)
      p2 (nth 1 co-ord)
      p3 (nth 2 co-ord)
)
(setq d1 (distance p1 p2)
      d2 (distance p2 p3)
)
(setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)))
(if (> d1 d2)
(setq ang (angle p1 p2))
(setq ang (angle p2 p3))
)
(command "text" "J" "MC" mp 250 ang "ABC")
(setq i i+1)
)
)
(setvar 'aunits (oldang))
(princ)
)

 

[ronjonp]

Nice try! You were close

(defun c:wow (/ ang co-ord d1 d2 ent i mp oldang p1 p2 p3 rec)
  (vl-load-com)
  (setq oldang (getvar 'aunits))
  (setvar 'aunits 3)
  (setq i 0)
  (setq ent (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
  (if ent
    (repeat (sslength ent)
      ;; (setq rec (vlax-ename->vla-object (ssname ent i)))
      (setq rec (ssname ent i))
      ;; (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec)))))
      (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget rec))))
      (setq p1 (nth 0 co-ord)
	    p2 (nth 1 co-ord)
	    p3 (nth 2 co-ord)
      )
      (setq d1 (distance p1 p2)
	    d2 (distance p2 p3)
      )
      (setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)))
      (if (> d1 d2)
	(setq ang (angle p1 p2))
	(setq ang (angle p2 p3))
      )
      (command "text" "J" "MC" mp 250 ang "ABC")
      ;; (setq i i+1)
      (setq i (1+ i))
    )
  )
  ;; (setvar 'aunits (oldang))
  (setvar 'aunits oldang)
  (princ)
)

 

[BIGAL]

Thanks Ronjonp

 

 yxl030 good to see, you will get lots more help often behind the scenes if you have a go yourself and your learning. Rename "wow" to what you want.

 

Add (c:wow) as last line then when you load etc it will run straight away.

Edited August 26, 2021 by BIGAL

[yxl030]

Thank you for your patient guidance , Ronjonp !

It works very well now.

 

Thanks BIGAL, your code saved me a lot of time. 

You are right，Spent some time, I learned a lot .

 

[BIGAL]

Glad to help I do my repeats slightly different, note this processes in opposite order starting at last. Its just preference both ways work.

 

(repeat (setq i (sslength ent))
(setq rec (vlax-ename->vla-object (ssname ent  (setq i (1- i)))))
...
; no need for i + 1
) ; repeat

 

[Browning Zed]

On 8/25/2021 at 7:29 AM, BIGAL said:

Try this has a homework attached google text readable hint lee-mac.

 

; simple text at mid of rectang alanh AUG 2021

(defun c:wow ( / rec co-ord p1 p2 p3 and d1 d2)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(while (setq rec (entsel "\npick rectang Enter to exit"))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec)))))
(setq p1 (nth 0 co-ord)
      p2 (nth 1 co-ord)
      p3 (nth 2 co-ord)
)
(setq d1 (distance p1 p2)
      d2 (distance p2 p3)
)
(setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)))
(if (> d1 d2)
(setq ang (angle p1 p2))
(setq ang (angle p2 p3))
)
(command "text" mp 2.5 ang "abc")
)
(setvar 'aunits (oldang))
(princ)
)

 

Great routine, BIGAL. May I ask you to modify the code so that the text is rotated not according to the longest border of the rectangle, but according to the border picked by (entsel) method? Like the picture below.

[BIGAL]

When you select a pline you can get which segment did you pick via code. The answer is in label a chamfer I think it was here a few days ago.