A simple lisp needed

March 6, 2012

Could some one help me plz

- get a point

- Select first text to move to new location

- Select second text to move to new location

Thanks

Edit: To be repeated. its huge plan

March 6, 2012

One solution:

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
            (setq label1st (car (entsel))
                  label2nd (car (entsel))))
 (progn
  (foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (list '10 (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint))
                 (assoc 10 entList)
                 entList))
  )
 )
)
(princ)
)

Regards,

Mircea

March 6, 2012

One solution:
...

Regards,

Mircea

Great Thanks

To repeated using WHILE and working fine

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while
  (if (and (setq thePoint (getpoint "\nInsertion point: "))
         (setq label1st (car (entsel))
               label2nd (car (entsel))))
 (progn
  (foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (list '10 (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint))
                 (assoc 10 entList)
                 entList))
  )
 )
)
  )
(princ)
)

March 6, 2012

You’re welcome!

Have noticed late the repeat request - you can check the revised version. However, your change is OK too.

Regards,

Mircea

March 6, 2012

You’re welcome!
...

Regards,

Mircea

tried to avoid UCs change

But not worked

(defun C:Mll ( / thePoint label1st label2nd moveSet entList)
(while t
  (if (and (setq thePoint (getpoint "\nInsertion point: "))
         (setq label1st (car (entsel))
               label2nd (car (entsel))))
 (progn
   (setq thePoint (trans thePoint 1 0))
  (foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (list '10 (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint))
                 (assoc 10 entList)
                 entList))
  )
 )
)
  )
(princ)
)

March 6, 2012

Should transpose the point after calculate displacement (presuming that the UCS is aligned with reference):

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
            (setq label1st (car (entsel))
                  label2nd (car (entsel))))
 (progn
  (foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
                 (assoc 10 entList)
                 entList))
  )
 )
)
(princ)
)

Regards,

Mircea

March 6, 2012

Should transpose
...

Regards,

Mircea

Thanks Mircea

March 6, 2012

Just play with the values that I have colored in red (X), blue (Y1) and green (Y2) to match your case.

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
            (setq label1st (car (entsel))
                  label2nd (car (entsel))))
 (progn
  (foreach moveSet (list (list label1st [color=red]300.0[/color] [color=blue]-100.0[/color])
                         (list label2nd [color=blue][color=red]300.0[/color][/color] [color=green]-400.0[/color]))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
                 (assoc 10 entList)
                 entList))
  )
 )
)
(princ)
)

Regards,

Mircea

March 6, 2012

Just play with the values that I have colored in red (X), blue (Y1) and green (Y2) to match your case.

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
(setq label1st (car (entsel))
label2nd (car (entsel))))
(progn
(foreach moveSet (list (list label1st [color=red]300.0[/color] [color=blue]-100.0[/color])
(list label2nd [color=blue][color=red]300.0[/color][/color] [color=green]-400.0[/color]))
(setq entList (entget (car moveSet)))
(entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
(assoc 10 entList)
entList))
)
)
)
(princ)
)

Regards,

Mircea

Excuse me Mircea,

I believe that I was not very clear earlier.

Do not want to select the point, but the POLYLINE.

And that texts are always located from the lower right corner of the polyline.

March 6, 2012

Just pick the lower-right corner

March 6, 2012

Just pick the lower-right corner

The same answer

Just pick the point

March 28, 2012

Thanks Mircea

Hi to all,

This routine is very helpful to me.

I have a question:

How to filter selection "label1st" only if the object is on layer XXX, and the selection of "label2nd" only if the object is on layer YYY?

Thanks in advance.

March 28, 2012

Thanks for the comments.

To filter the labels by specific layers, just modify the code below with you layer names:

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
            (setq label1st (ssget "_:S:E" '((0 . "TEXT") (8 . "[color=magenta]XXX[/color]"))))
            (setq label2nd (ssget "_:S:E" '((0 . "TEXT") (8 . "[color=magenta]YYY[/color]")))))
 (progn
  (setq label1st (ssname label1st 0)
        label2nd (ssname label2nd 0))
  (foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
                 (assoc 10 entList)
                 entList))
  )
 )
)
(princ)
)

Regards,

Mircea

March 28, 2012

Thanks for the comments.

To filter the labels by specific layers, just modify the code below with you layer names:

(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
(setq label1st (ssget "_:S:E" '((0 . "TEXT") (8 . "[color=magenta]XXX[/color]"))))
(setq label2nd (ssget "_:S:E" '((0 . "TEXT") (8 . "[color=magenta]YYY[/color]")))))
(progn
(setq label1st (ssname label1st 0)
label2nd (ssname label2nd 0))
(foreach moveSet (list (list label1st 300.0 0.0)
(list label2nd 300.0 400.0))
(setq entList (entget (car moveSet)))
(entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
(assoc 10 entList)
entList))
)
)
)
(princ)
)

Regards,

Mircea

Mircea, thanks for your reply.

I understood the logic of its modification, but is returning the following error:

Command: MoveLabels
nInsertion point:
Select objects:
Select objects:
ERROR: bad argument type: lentityp <Selection set: 151>
Command:

March 28, 2012

Can you post please how you changed the code from post #13 to suit your case?

Regards,

Mircea

March 28, 2012

Can you post please how you changed the code from post #13 to suit your case?

Regards,

Mircea

This is my changed code:

(defun c:ML ( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nPoint: "))
            (setq label1st (ssget "_:S:E" '((0 . "TEXT") (8 . "LAYER1"))))
            (setq label2nd (ssget "_:S:E" '((0 . "TEXT") (8 . "LAYER2")))))
 (progn
  (foreach moveSet (list (list label1st 10.0 -25.0)
                         (list label2nd 10.0 -42.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
                 (assoc 10 entList)
                 entList))
  )
 )
)
(princ)
)

March 28, 2012

Im afraid that you forgot to copy some lines:

(defun c:ML ( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nPoint: "))
            (setq label1st (ssget "_:S:E" '((0 . "TEXT") (8 . "LAYER1"))))
            (setq label2nd (ssget "_:S:E" '((0 . "TEXT") (8 . "LAYER2")))))
 (progn
[color=red]   (setq label1st (ssname label1st 0)
        label2nd (ssname label2nd 0))[/color]
  (foreach moveSet (list (list label1st 10.0 -25.0)
                         (list label2nd 10.0 -42.0))
  (setq entList  (entget (car moveSet)))
  (entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
                 (assoc 10 entList)
                 entList))
  )
 )
)
(princ)
)

Regards,

Mircea

Sign In

A simple lisp needed

Recommended Posts

asos2000

MSasu

asos2000

MSasu

asos2000

MSasu

asos2000

MSasu

antistar

Lee Mac

asos2000

antistar

MSasu

antistar

MSasu

antistar

MSasu

Join the conversation

Tutorials

Forums

Activity