request to create a straight-or-angular-offset-or-stretch.lsp

[jtm2020hyo]

I need to copy or move any object(s) (like polylines or dynamic blocks) exactly how Offset-lsp and Stretch-lsp work for angular and straight cases

ATTACHED a file where you can test your code.

[ВeekeeCZ]

Just out of curiosity, how do Offset-lst and Stretch-lsp behave? 

[jtm2020hyo]

I need to change the title to "request to update attached or create radial-copy-move-array-lisp"     

Attached files below.

I need to update lisp to work with *lines, text, regular blocks or dynamic blocks. attached lisp-routines sometimes work others not.

Radial-move-copy-array.lsp routines should request to select objects to move/copy/array, then select 2 points to generate a circle, then request to select another point to generate another circle with the same center, then objects should be copy/move/array points from selected objects like SCALE COMMAND work. scale factor should be equivalent to our 2 circles creates.

for blocks or texts should be considered insert-point, for *lines their vertex, for closed objects like circles should be considered geometric-center. 

[jtm2020hyo]

---

@ВeekeeCZ wrote:

Just out of curiosity, how do Offset-lst and Stretch-lsp behave? 

---

I mean OFFSET COMMAND and STRETCH COMMAND.

I need to work with all objects selected (like SCALE COMMAND)

[jtm2020hyo]

here attached tested file.

maybe someone need it.

[ronjonp]

Here's a quick one to polar copy blocks:

(defun c:foo (/ b c d p s)
  ;; RJP » 2018-12-03
  (cond	((and (setq s (ssget ":L" '((0 . "insert"))))
	      (setq p (getpoint "\nPick point for radial copy: "))
	      (progn (initget 3) (setq d (getdist "\nEnter distance to move: ")))
	 )
	 (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq b (vla-copy (vlax-ename->vla-object x)))
	   (vlax-invoke
	     b
	     'move
	     (setq c (vlax-get b 'insertionpoint))
	     (polar p (angle p c) (+ d (distance p c)))
	   )
	 )
	)
  )
  (princ)
)

[jtm2020hyo]

---

@ronjonp wrote:

Here's a quick one to polar copy blocks:

(defun c:foo (/ b c d p s)
  ;; RJP » 2018-12-03
  (cond	((and (setq s (ssget ":L" '((0 . "insert"))))
	      (setq p (getpoint "\nPick point for radial copy: "))
	      (progn (initget 3) (setq d (getdist "\nEnter distance to move: ")))
	 )
	 (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq b (vla-copy (vlax-ename->vla-object x)))
	   (vlax-invoke
	     b
	     'move
	     (setq c (vlax-get b 'insertionpoint))
	     (polar p (angle p c) (+ d (distance p c)))
	   )
	 )
	)
  )
  (princ)
)

---

Cool.
I need to do 2 requests to this LSP.

1) Can you add a stretch function for STRETCH that polylines?

2) Can you add an option to move blocks? (I mean copy then and delete originals)

[ronjonp]

Try this .. although I'm not sure why you don't just use the scale command, then reapply the original scale of your blocks.

(defun c:foo (/ _off a b c d p s)
  (defun _off (o d / r)
    (cond ((= 'list (type (setq r (vl-catch-all-apply 'vlax-invoke (list o 'offset d))))) (car r)))
  )
  ;; RJP » 2018-12-03
  (cond	((and (setq s (ssget ":L" '((0 . "insert,lwpolyline,circle"))))
	      (setq p (getpoint "\nPick point for radial copy: "))
	      (progn (initget 3) (setq d (getdist "\nEnter distance to move: ")))
	 )
	 (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq o (vlax-ename->vla-object x))
	   (cond ((vlax-property-available-p o 'insertionpoint)
		  (vlax-invoke
		    o
		    'move
		    (setq c (vlax-get o 'insertionpoint))
		    (polar p (angle p c) (+ d (distance p c)))
		  )
		 )
		 ((and (setq a (_off o d)) (setq b (_off o (- d))))
		  (if (< (vla-get-area a) (vla-get-area b))
		    (vla-delete a)
		    (vla-delete b)
		  )
		  (vla-delete o)
		 )
		 ((mapcar '(lambda (e) (vl-catch-all-apply 'vla-delete (list e))) (list a b)))
	   )
	 )
	)
  )
  (princ)
)

[jtm2020hyo]

---

@ronjonp wrote:

Try this .. although I'm not sure why you don't just use the scale command, then reapply the original scale of your blocks.

thanks for your reply. pretty close to what I need

I found that this code is work just in one way and just moving. (pushing away the blocks from the circular center)

I need copy blocks in a radial way in both ways. (pushing away the blocks and approaching the blocks from the circular center)

[ronjonp]

Sorry .. I'm not exactly sure what you're asking.

[dbhunia]

I had modified only your attached "radialmove-new.lsp" for the Red highlighted things only...... (As the way your given code works)..... First you check this after that I shall move for other files.....

---

@jtm2020hyo wrote:
.................................

I need to update lisp to work with *lines, text, regular blocks or dynamic blocks. attached lisp-routines sometimes work others not.

Radial-move-copy-array.lsp routines should request to select objects to move/copy/array, then select 2 points to generate a circle, then request to select another point to generate another circle with the same center, then objects should be copy/move/array points from selected objects like SCALE COMMAND work. scale factor should be equivalent to our 2 circles creates.

for blocks or texts should be considered insert-point, for *lines their vertex, for closed objects like circles should be considered geometric-center. 

---

By considering the "BoundingBox center" of each objects...... Try this....

(defun c:radialmove-new ( / ssx i ent p c d entplst)
(vl-load-com)
(setq c (getpoint "\nPick or specify center point for radial move : "))
(setq d (getdist "\nEnter distance to move: "))
(Princ "\nSelect Objects To Move Radially")
(setq ssx (ssget))
(setq i -1)
  (while (setq ent (ssname ssx (setq i (1+ i))))
    (vla-getBoundingBox (vlax-ename->vla-object ent) 'minpt 'maxpt)
	(setq p
	   (mapcar '/
           (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
           '(2 2 2)
        )
    )
    (if p 
      (progn
        (setq p (list (car p) (cadr p) (caddr p)))
        (setq entplst (cons (cons p ent) entplst))
      )
    )
  )
  (foreach entp entplst
     (if (equal c (car entp) 1E-13) ()
    	(command "_.move" (cdr entp) "" (car entp) (polar c (angle c (car entp)) (+ d (distance (car entp) c))))
     )
  )
(princ)
)

For the Blue highlighted things,... have to put different conditions into the code for different types of objects.......

Personally for me first show me your "Home Work" for the above conditions ......... then I surely help you.....

Tested in AutoCAD 2007.....

[jtm2020hyo]

@dbhunia @ronjonp @ВeekeeCZ

thanks a lot for your replies.

their latest codes work very similar to what I need.

What I need is simple.

I need the lisp code to ask to enter a common center for 2 radios (start radius and final radius). after the code copies the selected objects by rotating in an angular way and climbing radially (the insertion points) from the starting radius to the final radius.

if the first radius is at the top 90 degrees to the center of an imaginary radius (required by the code) at a distance of 1 unit and the final radius to the right at an angle 0 degrees and at a distance of 0.5 units. then the selected elements must be rotated angularly at 90 to 0 degrees and scaled in radial direction (the insertion points) from 1 unit to 0.5 units.

[jtm2020hyo]

the image below is climbing to 1.2 and keeps the rotation at 45 degrees.

It is a good example of what I want to say.