Lisp move Block HELP

[chan230984]

HI all, Please Help me write LISP

I want to move the Block Go to the middle of the polyline.

Make the corner of the block. Stick with

Picture below

Thanks

[cadffm]

Delete

[chan230984]

I want to click block and polyline to move block near polyline

Sorry I'm not good English

[devitg]

please, upload your sample dwg

[john.uhden]

Does your block actually have lines or a polyline around its boundary, or would that be derived by a boundingbox around one inserted at a 0° angle?  I do see a method for calculating the intersection points.  Of course it would probably be written assuming that the polyline always looked something like the one in your image.  Is the block allowed to be rotated a little?

[chan230984]

This is an Example 

Because i have a lot to do it

I want a quick way to do it.

Thanks

[cadffm]

---

chan230984 schrieb:

HI all, Please Help me write LISP

---

Sure,

please write about your current problem for this Task, which way do you want to go

and show your your previous result(code)

One way should be:
Congruence calculate with c=Length of "Block" and angle of alpha+beta, or alpha+gamma or beta+gamma

Congruence (geometry)
You can use the ASA or AAS (S= the side of your rectang/Block)
https://www.khanacademy.org/math/geometry/hs-geo-congruence/hs-geo-triangle-congruence/a/triangle-co...
https://en.wikipedia.org/wiki/Congruence_%28geometry%29#Determining_congruence

[Kent1Cooper]

There's a relatively quick way to do it manually:  Move the Block and Text so that its [in this case] upper left corner lies anywhere along the left leg of the Polyline [in the image, I have already Moved them [the dashed blue is the original position] to put the Block's insertion point at the far left end, but you could put that location at the MIDpoint, or with a NEArest Osnap anywhere].  Draw a temporary Line along that left leg, and Move that [maintaining its angle] so that it passes through the [in this case] upper-right corner of the Block [the green Line here, already so Moved].  Finally, Move the Block and Text between the obvious INTersection points, and Erase the temporary Line.

To automate that could be very tricky.  The Block in that skewed orientation is at 0 rotation, which makes it a lot harder to extract where that upper right corner is from its information, than it would be if the Block at 0 rotation were orthogonally oriented.  The starting vertex of the Polyline in the Block is not at the Block's insertion point, and I can't imagine you could always count on that Polyline being drawn always from the same corner and always in the same direction, nor that the white Polyline would always be drawn in the same direction.  And the Text is a separate object from the Block, so a routine would presumably also need to ask you to select that.

What are the "extreme" possibiliities here?  Are your examples so far "typical" in the sense that the white Polyline will always be three segments falling toward the ends, and the rectangle will always be underneath in a similar original position?  Or could there be significantly different starting conditions?  More Polyline segments?  Block above?  The whole thing rotated in some very different orientation?  Significantly different Block shape?  Etc.

I suspect that coming up with a foolproof way to account for all possibilities would be a lot more effort than just doing it manually, but I wouldn't claim it can't be done.  And it may be worth the effort, if you have a large enough quantity of them to process.

[Ranjit_Singh · Accepted solution]

Try attached code. Minimal testing and no error trap.

(defun c:somefunc  (/ ang ang1 dist ent1 ent2 ent3 entlst entlst2 entlst3 entmat entnew etdata found lst lst2 pt vlaobj vlaobj2)
 (and (setq ent1 (car (entsel "\nSelect polyline: "))
            ang1 (cdar
                  (vl-sort (mapcar '(lambda (x y) (cons (abs (sin (setq ang (angle x y)))) ang))
                                   (setq lst (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent1))))))
                                   (cdr lst))
                           '(lambda (x y) (< (car x) (car y)))))
            ent2 (car (setq entlst (nentsel "\nSelect rectangle in block: ")))
            ent3 (car (last entlst))
            lst  (vl-sort (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent1)))))
                          '(lambda (x y) (> (cadr x) (cadr y))))
            lst  (cons (car lst) (list (cadr lst)))
            lst2 (apply 'append
                        (mapcar '(lambda (x)
                                  (if (or (= 10 (car x)) (= 11 (car x)))
                                   (list
                                    (append (list (+ (* (car (nth 0 (setq entmat (caddr entlst)))) (cadr x))
                                                     (* (car (nth 1 entmat)) (caddr x))
                                                     (car (nth 3 entmat))))
                                            (list
                                             (+ (* (cadr (nth 0 entmat)) (cadr x)) (* (cadr (nth 1 entmat)) (caddr x)) (cadr (nth 3 entmat))))))))
                                (if (= "POLYLINE" (cdr (assoc 0 (entget (setq entlst2 (cdr (assoc 330 (entget ent2))))))))
                                 (progn (setq entnew entlst2)
                                        (while (/= "SEQEND" (cdr (assoc 0 (entget entnew))))
                                         (setq entnew (entnext entnew))
                                         (setq entlst3 (cons (reverse (cdr (reverse (assoc 10 (entget entnew))))) entlst3))))
                                 (entget ent2))))
            lst2 (vl-sort (mapcar '(lambda (x y) (cons (abs (- ang1 (abs (sin (angle x y))))) (list x y)))
                                  (setq lst2 (append lst2 (list (car lst2))))
                                  (cdr lst2))
                          '(lambda (x y) (> (car x) (car y))))
            lst2 (list (cdar lst2) (cdadr lst2))
            lst2 (car (vl-sort (mapcar '(lambda (x) (vl-sort x '(lambda (x y) (> (cadr x) (cadr y))))) lst2)
                               '(lambda (x y) (> (cadar x) (cadar y))))))
      (while (not found)
       (vla-move (setq vlaobj2 (vlax-ename->vla-object ent3))
                 (vlax-3d-point (car lst2))
                 (vlax-3d-point (car lst)))
       (setq dist (distance (car lst2) (car lst))
             ang  (angle (car lst2) (car lst)))
       (setq lst2 (mapcar '(lambda (x) (polar x ang dist)) lst2))
       (vla-move (vla-copy (setq vlaobj (vlax-ename->vla-object ent1)))
                 (vlax-3d-point (car lst))
                 (vlax-3d-point (cadr lst2)))
       (if (setq pt (vlax-invoke vlaobj 'intersectwith (vlax-ename->vla-object (entlast)) 0))
        (setq found t))
       (entdel (entlast))
       (setq lst (cdr lst)))
      pt
      (vla-move vlaobj2 (vlax-3d-point (cadr lst2)) (vlax-3d-point pt)))
 (princ))

[chan230984]

@Ranjit_Singh

Thanks a lot