Copy object multi times and edit each time

Copy object multi times and edit each time

Sea-Haven
Mentor Mentor
440 Views
7 Replies
Message 1 of 8

Copy object multi times and edit each time

Sea-Haven
Mentor
Mentor

I am trying to copy an object in this case a rectang and as each copy is made add a text string ie a number into rectang.

 

It should be obvious to me but not finding a simple answer, tried a couple of ideas but I want the drag rectang to be visual when selecting where to place it the "copy object pt pause" for new point works fine, but wrapping it in a loop is a problem. 

 

I think the answer is in a GRREAD GRDRAW answer but that is something I have not used, so seeking help, can get the 4 corner pts easy and did see make vectors to use with GRDRAW. 

 

I am looking for same as copy function pick pick for new points but number is added as each rectang is added, rather than add all then number. That I can do.

 

SeaHaven_0-1675049418063.png

 

0 Likes
441 Views
7 Replies
Replies (7)
Message 2 of 8

Sea-Haven
Mentor
Mentor

I did manage to work out a GRDRAW for the rectang, but still look at how to do inside a while without having to say continue each time.

 

(defun c:wow ( / plent col len ht p1 p2 p3)
(setq col 1)
(setq plent (entsel "\nPick rectang"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(setq len (distance (nth 0 co-ord) (nth 1 co-ord)))
(setq ht (distance (nth 1 co-ord)(nth 2 co-ord)))
(while (= 5 (car (setq pnt (grread nil 13 0))))
(redraw)
(seqt p0 (cadr pnt))
(setq p1 (mapcar '+ p0 (list 0.0 ht 0.0)))
(setq p2 (mapcar '+ p0 (list len ht 0.0)))
(setq p3 (mapcar '+ p0 (list len 0.0 0.0)))
(setq pts (list col p0 p1 p2 p3 (cadr pnt)))
(grdraw p0 p1 col)
(grdraw p1 p2 col)
(grdraw p2 p3 col)
(grdraw p3 p0 col)
)
)

(c:wow)

 

 

0 Likes
Message 3 of 8

komondormrex
Mentor
Mentor

Hi. Generally speaking the routine may look like as follows. No grdraw thou.

(defun c:multiple_copying ( / initiate_copying command_stopped object_to_copy markup_text_object copy_reference_point grread_data
							  space_pressed
						  )
	(setq object_to_copy (vlax-ename->vla-object (car (entsel "\nPick frame object to multiple copy: ")))
		  markup_text_object (vlax-ename->vla-object (car (entsel "\nPick a markup text to multiple copy: ")))
	)
	(prompt "\rRight click to make a copy instance")
	(while (not command_stopped)
			(setq error_occurred (if (vl-catch-all-error-p (setq grread_data (vl-catch-all-apply 'grread (list t 12 0)))) t nil))
	    	(cond
				(
					error_occurred
						(alert "        Command stopped")                              ;	command cancellation
						(setq command_stopped t)
				)
				(
					(= 3 (car grread_data))                                        		;	left click
						(setq initiate_copying nil)
						(if space_pressed (setq space_pressed (not space_pressed)))
				)
				(
				   	(and initiate_copying
						 (= 5 (car grread_data))		                               ;	cursor moving
					)
						(if (not space_pressed)
								(progn
									(prompt "\rPosition a copy instance with left click, make a copy instance with rigth click, <Space> to position markup text")
									(foreach object (list object_to_copy markup_text_object)
										(vla-move object (vlax-3d-point copy_reference_point)
														 (vlax-3d-point (cadr grread_data))
										)
									)
								)
								(progn
									(vla-move markup_text_object (vla-get-insertionpoint markup_text_object)
																 (vlax-3d-point (cadr grread_data))
									)
									(prompt "\rPress <Space> to end positioning markup text")
								)
						)
						(setq copy_reference_point (cadr grread_data))
				)
				(
				   	(and (not initiate_copying)
						 (= 5 (car grread_data))		                                ;	cursor moving
					)
						(prompt "\rRight click to make a copy instance")
				)
				(
					(and
						(= 25 (car grread_data))		                                ;	right click
						(not space_pressed)
					)
						(prompt "\rPosition a copy instance with left click")
						(setq object_to_copy (vla-copy object_to_copy)
						      markup_text_object (vla-copy markup_text_object)
						)
						(setq initiate_copying t)
						(vla-put-textstring markup_text_object (itoa (1+ (atoi (vla-get-textstring markup_text_object)))))
						(vla-getboundingbox object_to_copy 'llc 'urc)
						(setq copy_reference_point (vlax-safearray->list llc))
				)
				(
				 	(equal grread_data '(2 32))											;	Space
						(setq space_pressed (not space_pressed))
				)
				(
					(or
						(equal grread_data '(2 101))								;	e
						(equal grread_data '(2 69))									;	E
					)
						(if space_pressed
					   		(command-s "_textedit" "_m" "_s" (vlax-vla-object->ename markup_text_object))
					   		(command-s "_textedit" "_m" "_s" (car (entsel "\nSelect a text to edit")))
						)
				)
				(
					t
				)
			)
	)
	(princ)
)

 

 

0 Likes
Message 4 of 8

Kent1Cooper
Consultant
Consultant

@Sea-Haven wrote:

I am trying to copy an object in this case a rectang and as each copy is made add a text string ie a number into rectang.

....


Does a Text object also already exist, that can be selected along with the rectangle?  If it does, with a numerical value, it shouldn't be hard to include incrementing that value as it is copied.  And it looks like a routine would need to have the User position the Text as well as and independently of the rectangle.

Kent Cooper, AIA
0 Likes
Message 5 of 8

Kent1Cooper
Consultant
Consultant

@Kent1Cooper wrote:

....

Does a Text object also already exist, that can be selected along with the rectangle?  If it does, with a numerical value, it shouldn't be hard to include incrementing that value as it is copied.  And it looks like a routine would need to have the User position the Text as well as and independently of the rectangle.


For example [lightly tested]:

 

(defun C:COTI ; = Copy Outline and Text Incremented
  (/ *error* outl txtsel txtent txtobj str outlmid txtmid)
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (prompt (strcat "\nError: " errmsg))
    ); if
    (entdel outl) (entdel txtent)
    (prin1)
  ); defun - *error*
  (if
    (and
      (setq outl (car (entsel "\nSelect outline object to copy: ")))
      (setq txtsel (entsel "\nSelect numerical Text to increment with each new outline: "))
      (wcmatch (cdr (assoc 0 (entget (setq txtent (car txtsel))))) "*TEXT")
      (setq str (vla-get-TextString (setq txtobj (vlax-ename->vla-object txtent))))
      (= (itoa (atoi str)) str); content represents integer [also no intermal formatting if Mtext]
    ); and
    (progn ; then
      (vla-getboundingbox (vlax-ename->vla-object outl) 'minpt 'maxpt)
      (setq outlmid (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2)))
      (vla-getboundingbox txtobj 'minpt 'maxpt)
      (setq txtmid (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2)))
      (alert "Place outlines, then incremented text; press ESCape to end.")
      (while T
        (command "_.copy" outl txtent "" "0,0" "0,0")
        (command "_.move" outl "" outlmid pause)
        (setq outlmid (getvar 'lastpoint))
        (vla-put-TextString txtobj (setq str (itoa (1+ (atoi str)))))
        (command "_.move" txtent "" txtmid pause)
        (setq txtmid (getvar 'lastpoint))
      ); while
    ); progn
    (prompt "\nDid not select an outline object and numerical text object.")
  ); if
  (prin1)
)

 

It could use Undo begin/end wrapping, but that can be added if it does what you want otherwise.  It could get other refinements, such as an option to increment the text content by something other than 1, and/or downward, etc.

 

It continually Copies the original selected objects in place, leaves the copies and Moves the originals, including incrementing the text content before Moving it, so you see it with its changed value as you place it.

 

The "outline" object can be anything -- it doesn't need to be a rectangle.  If it is one, it can be a Polyline or a Block or a Region or a Surface, but it can also be a Circle or an Ellipse or....  Since it is simply Copied, there's no need for (grdraw), dealing with Layers, etc.  [Would it be worth checking that the selected objects are on unlocked Layers?]

Kent Cooper, AIA
0 Likes
Message 6 of 8

CADaSchtroumpf
Advisor
Advisor

My try

You select a rectangle, Choice your increment with introduce for exemple "A1" or "15" or "100.1" and dynamic mode give the position of the other rectangle at the cursor.

Left-click for validate position Rigth-click for exit

Work's in all UCS

(vl-load-com)
(defun inc_txt (Txt / Loop Val_Txt Ascii_Txt Gaps)
  (setq
    Loop 1
    Val_txt ""
  )
  (while (<= Loop (strlen Txt))
    (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Loop)))
    (if (not Gaps)
      (setq Ascii_Txt (1+ Ascii_Txt))
    )
    (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123))
      (setq
        Ascii_Txt
        (cond
          ((= Ascii_Txt 58) 48)
          ((= Ascii_Txt 91) 65)
          ((= Ascii_Txt 123) 97)
        )
        Gaps nil
      )
      (setq Gaps T)
    )
    (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt))
    (setq Loop (1+ Loop))
  )
  (if (not Gaps)
    (setq Val_Txt
      (strcat
        (cond
          ((< Ascii_Txt 58) "0")
          ((< Ascii_Txt 91) "A")
          ((< Ascii_Txt 123) "a")
        )
        Val_Txt
      )
    )
  )
  Val_Txt
)
(defun c:multi_copy-rect ( / ss sv_zp AcDoc Space ename obj norm n_ini htx nw_obj pt nw_pt copy_obj copy_nw_obj tmp nb nb_dec inc)
  (princ "\nSelect rectangle.")
  (while
    (null
      (setq ss
        (ssget "_+.:E:S"
          '(
            (0 . "*POLYLINE")
            (-4 . "<NOT")
              (-4 . "&") (70 . 112)
            (-4 . "NOT>")
          )
        )
      )
    )
    (princ "\nIs empty, or isn't POLYLINES!")
  )
  (setq sv_zp (getvar "dimzin"))
  (setvar "dimzin" 4)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    ename (ssnamex ss 0)
    obj (vlax-ename->vla-object (cadar ename))
    norm (if (vlax-property-available-p obj 'Normal) (vlax-get obj 'Normal) '(0.0 0.0 1.0))
  )
  (if (not n_next)
    (setq n_ini (getstring "\nIncrement starting at [digit/letter/alphanumeric]:") n_next n_ini)
    (setq n_ini n_next)
  )
  (initget 6)
  (setq htx (getdist (trans (cadar (cdddar ename)) 0 1) (strcat "\nText height? <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (initget 1)
  (setq nw_obj
    (vla-addMtext Space
      (vlax-3d-point (trans (getpoint "\nInsertion of the text:") 1 0))
      0.0
      (strcat "{\\fArial;" n_next "}")
    )
  )
  (mapcar
    '(lambda (pr val)
      (vlax-put nw_obj pr val)
    )
    (list 'AttachmentPoint 'Height 'DrawingDirection 'Layer 'Rotation 'Normal)
    (list 8 (getvar "TEXTSIZE") 5 (getvar "CLAYER") (atan (/ (cadr (getvar "UCSXDIR")) (car (getvar "UCSXDIR")))) norm)
  )
  (setq nw_pt (vlax-3d-point (cadar (cdddar ename))))
  (setq copy_obj (vla-Copy obj))
  (setq copy_nw_obj (vla-Copy nw_obj))
  (while (or (= 5 (car (setq tmp (grread t 5 0)))) (/= (car tmp) 25) (= (car tmp) 3))
    (setq pt (vlax-3d-point (trans (cadr tmp) 1 0)))
    (cond
      ((= 5 (car tmp))
        (vla-Move copy_obj nw_pt pt)
        (vla-Move copy_nw_obj nw_pt pt)
        (setq nw_pt pt)
      )
      ((= 3 (car tmp))
        (cond
          ((eq (type (read n_ini)) 'INT)
            (setq n_next (itoa (1+ (atoi n_ini))))
          )
          ((eq (type (read n_ini)) 'REAL)
            (setq nb 0)
            (repeat (strlen n_ini)
              (if (eq (substr n_ini (setq nb (1+ nb)) 1) ".")
                (setq nb_dec (1- (strlen (substr n_ini nb))))
              )
            )
            (setq inc 1.0)
            (repeat nb_dec (setq inc (/ inc 10)))
            (setq n_next (rtos (+ inc (atof n_ini)) 2 nb_dec))
          )
          ((eq (type n_ini) 'STR)
            (setq n_next (inc_txt n_ini))
          )
        )
        (setq n_ini n_next)
        (vla-Move copy_obj nw_pt pt)
        (vla-Move copy_nw_obj nw_pt pt)
        (vlax-put copy_nw_obj 'TextString n_next)
        (setq nw_pt (vlax-3d-point (cadar (cdddar ename))))
        (setq copy_obj (vla-Copy obj))
        (setq copy_nw_obj (vla-Copy nw_obj))
      )
    )
  )
  (entdel (entlast))
  (entdel (entlast))
  (setvar "dimzin" sv_zp)
  (prin1)
)

 

0 Likes
Message 7 of 8

Sea-Haven
Mentor
Mentor

Thank you for your efforts.

 

The numeric value is actually retrieved via a ldata so last number is known hence no need to read number from any rectang picked to be copied. Also allows for multi goes of copy, you know get called away in middle of using, last number is saved when copy made.

 

I tried all 3 and copying is working in all versions. A quick note tried in Bricscad and Autocad, had problems with Bricscad not working properly so tested all in Acad, Will go back to Bricscad later and try to work out why not working.

 

What is obvious for me is to use the error trap with Esc to stop making new copies. The idea of using mouse buttons by komondormrex is interesting concept that I have not seen before. Whilst I like it I think for unknown users press Esc is easier.

 

It also shows no need to use grdraw etc. 

 

Again thank you I should be ok now. Will post something later. 

 

 

0 Likes
Message 8 of 8

komondormrex
Mentor
Mentor

@Sea-Haven 

Hi there.

Added <Space> pressing to moving markup text  and <e,E> to editing markup text. Both on the fly. 

0 Likes