Jump to content

Draw near points of text entities

teknomatika

By teknomatika
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

teknomatika Rising Star

teknomatika

Posted
Posted

I look for a routine that will resolve the following task:

 

1 - I select a group of text entities (in this case numbers)

2 - Then I draw a point near the position of one

3 - Finally, the routine must be able to replicate the point in the other text strings, maintaining the same close relationship defined in step 2

 

Attached a drawing to better understand

Tanks for help!

cadtutor_test_points.dwg

JamCAD Enthusiast

JamCAD

Posted
Posted

Try this

(defun c:txtpt (/ txt1 txtpt pt ss i ptsz ang dist ip pt1 pt2 pt3 pt4)
 (setq    txt1  (progn (princ "Pick First M/Text Object")
            (ssget "_+.:E:S" '((0 . "*TEXT")))
         )
   txtpt (cdr (assoc 10 (entget (ssname txt1 0))))
   pt    (getpoint txtpt "\nSelect loction of point")
   ss    (progn (princ "Select All M/Text Objects")
            (ssget '((0 . "*TEXT")))
         )
   i     0
   ptsz  (getreal "\nHow large should the point be?")
   ang
         (angle txtpt pt)
   dist
         (distance txtpt pt)
 )
 (while (< i (sslength ss))
   (setq ip  (polar
       (cdr (assoc 10 (entget (ssname ss i))))
       ang
       dist
         )
     pt1 (polar ip (/ pi 2) (/ ptsz 2))
     pt2 (polar ip (* pi 1.5) (/ ptsz 2))
     pt3 (polar ip 0 (/ ptsz 2))
     pt4 (polar ip pi (/ ptsz 2))
   )
   (command "line" pt1 pt2 "")
   (command "line" pt3 pt4 "")
   (command "circle" ip (/ ptsz 4))
   (setq i (1+ i))
 )
)

teknomatika Rising Star

teknomatika

Posted
  • Author
Posted (edited)

That's it. However, it is not necessary to draw the symbol as in my example. My intention was that it be interpreted as a point. I just want to be drawn to simple point entity.

 

I appreciate the update.

Edited by teknomatika
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

I think this way solves what I want.

 

(defun c:txtpt (/ txt1 txtpt pt ss i ptsz ang dist ip)
 (setq    txt1  (progn (princ "Pick First M/Text Object")
            (ssget "_+.:E:S" '((0 . "*TEXT")))
         )
   txtpt (cdr (assoc 10 (entget (ssname txt1 0))))
   pt    (getpoint txtpt "\nSelect loction of point")
   ss    (progn (princ "Select All M/Text Objects")
            (ssget '((0 . "*TEXT")))
         )
   i     0
   ang
         (angle txtpt pt)
   dist
         (distance txtpt pt)
 )
 (while (< i (sslength ss))
   (setq ip  (polar
       (cdr (assoc 10 (entget (ssname ss i))))
       ang
       dist
         )
   )
   (command "point" ip)
   (setq i (1+ i))
 )
)

Tharwat Grand Master

Tharwat

Posted
Posted

Try ..

 

(defun c:Test (/ *error* c s n sn e aa ab ac)
 ;;    Tharwat 23.05.2014        ;;
 (defun *error* (msg)
   (command "_.ucs" "_w")
   (if c (setvar 'cmdecho c))
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ msg)
     (princ (strcat "Error : < ** " msg " ** >"))
   )
 )
 (if (zerop (getvar 'PDMODE))
   (setvar 'PDMODE 34)
 )
 (setq c (getvar 'cmdecho))
 (setvar 'cmdecho 0)
 (if (setq s (ssget '((0 . "TEXT"))))
   (repeat (setq n (sslength s))
     (setq sn (ssname s (setq n (1- n))))
     (setq e (textbox (list
                        (cons -1 sn)
                      )
             )
     )
     (command "_.ucs" "Object" sn)
     (setq aa (car e)
           ab (cadr e)
           ac (list (car ab) (cadr aa))
     )
     (command "_.point"
              "_non"
              (list (car ac)
                    (- (cadr ac) (/ (cdr (assoc 40 (entget sn))) 2.))
              )
     )
   )
 )
 (command "_.ucs" "_w")
 (setvar 'cmdecho c)
 (princ)
)

teknomatika Rising Star

teknomatika

Posted
  • Author
Posted (edited)

Tharwat,

tanks!

 

I appreciate the work. As always, perfect.

It is an interesting option and that also solves my need.

However, I prefer the solution already presented in this thread, because it allows the set point position for each text string.

The location of the point shown in the drawing that I have attached, is just one example.

The main idea is that the position of the point relative to the text string can be pre-defined.

Edited by teknomatika
Tharwat Grand Master

Tharwat

Posted
Posted
Tharwat,

tanks!

 

I appreciate the work. As always, perfect.

It is an interesting option and that also solves my need.

 

Happy to hear that . :)

 

However, I prefer the solution already presented in this thread, because it allows the set point position for each text string.

Not a problem , I just wanted to make life easier as best as I can . ;)

 

Good luck .

Lee Mac Grand Master

Lee Mac

Posted
Posted

Here is another way to approach the task:

[color=GREEN];; Text Point  -  Lee Mac[/color]
[color=GREEN];; Prompts the user to specify the location of a point relative to a single text object[/color]
[color=GREEN];; and generates a point in the same location relative to every text object in a selection.[/color]

([color=BLUE]defun[/color] c:txp ( [color=BLUE]/[/color] ang ent enx idx ocs sel vec )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0)
           ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect source text object: "[/color])))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]null[/color] ent) [color=BLUE]nil[/color])
               (   ([color=BLUE]/=[/color] [color=MAROON]"TEXT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ent))))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nSelected object is not a text object."[/color])
               )
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] ent))
            ([color=BLUE]setq[/color] vec ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify point: "[/color]))
            ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"TEXT"[/color]))))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color]
               enx ([color=BLUE]entget[/color] ent)
               ang ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 050 enx))
               ocs ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 enx))
               vec
               (mxv
                   (mxm
                       ([color=BLUE]list[/color]
                           ([color=BLUE]list[/color] ([color=BLUE]/[/color] 1.0 (([color=BLUE]lambda[/color] ( box ) ([color=BLUE]-[/color] ([color=BLUE]caadr[/color] box) ([color=BLUE]caar[/color] box))) ([color=BLUE]textbox[/color] enx))) 0.0 0.0)
                           ([color=BLUE]list[/color] 0.0 ([color=BLUE]/[/color] 1.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 040 enx))) 0.0)
                          '(0.0 0.0 1.0)
                       )
                       (mxm
                           ([color=BLUE]list[/color]
                               ([color=BLUE]list[/color] ([color=BLUE]cos[/color] ang)     ([color=BLUE]sin[/color] ang) 0.0)
                               ([color=BLUE]list[/color] ([color=BLUE]-[/color] ([color=BLUE]sin[/color] ang)) ([color=BLUE]cos[/color] ang) 0.0)
                              '(0.0 0.0 1.0)
                           )
                           ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( v ) ([color=BLUE]trans[/color] v ocs 0 [color=BLUE]t[/color]))
                              '(
                                   (1.0 0.0 0.0)
                                   (0.0 1.0 0.0)
                                   (0.0 0.0 1.0)
                               )
                           )
                       )
                   )
                   ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] ([color=BLUE]trans[/color] vec 1 0) ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx)) ent 0))
               )
           )
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx))))
                     ang ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 050 enx))
                     ocs ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 enx))
               )
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"POINT"[/color])
                       ([color=BLUE]cons[/color] 10
                           ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx)) ocs 0)
                               (mxv
                                   (mxm
                                       ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( v ) ([color=BLUE]trans[/color] v 0 ocs [color=BLUE]t[/color]))
                                          '(
                                               (1.0 0.0 0.0)
                                               (0.0 1.0 0.0)
                                               (0.0 0.0 1.0)
                                           )
                                       )
                                       (mxm
                                           ([color=BLUE]list[/color]
                                               ([color=BLUE]list[/color] ([color=BLUE]cos[/color] ang) ([color=BLUE]-[/color] ([color=BLUE]sin[/color] ang)) 0.0)
                                               ([color=BLUE]list[/color] ([color=BLUE]sin[/color] ang)    ([color=BLUE]cos[/color] ang)  0.0)
                                              '(0.0 0.0 1.0)
                                           )
                                           ([color=BLUE]list[/color]
                                               ([color=BLUE]list[/color] (([color=BLUE]lambda[/color] ( box ) ([color=BLUE]-[/color] ([color=BLUE]caadr[/color] box) ([color=BLUE]caar[/color] box))) ([color=BLUE]textbox[/color] enx)) 0.0 0.0)
                                               ([color=BLUE]list[/color] 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 040 enx)) 0.0)
                                              '(0.0 0.0 1.0)
                                           )
                                       )
                                   )
                                   vec
                               )
                           )
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Matrix Transpose  -  Doug Wilson[/color]
[color=GREEN];; Args: m - nxn matrix[/color]

([color=BLUE]defun[/color] trp ( m )
   ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]list[/color] m))
)

[color=GREEN];; Matrix x Matrix  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m,n - nxn matrices[/color]

([color=BLUE]defun[/color] mxm ( m n )
   (([color=BLUE]lambda[/color] ( a ) ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) (mxv a r)) m)) (trp n))
)

[color=GREEN];; Matrix x Vector  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m - nxn matrix, v - vector in R^n[/color]

([color=BLUE]defun[/color] mxv ( m v )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) ([color=BLUE]apply[/color] '[color=BLUE]+[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]*[/color] r v))) m)
)

([color=BLUE]princ[/color])

The above will account for the varying position, rotation, width, height & orientation of every text object in the selection, and will also perform correctly under all UCS & View settings.

teknomatika Rising Star

teknomatika

Posted
  • Author
Posted (edited)

Lee,

Fantastic! Perfect! In fact very versatile.

Thanks for the excellent work.

Edited by teknomatika
Tharwat Grand Master

Tharwat

Posted
Posted

@ teknomatika

Just a thought , I don't think it's a good idea to quote every reply with all it codes so that would increase the size of the thread and would be boring to scroll too long for every reply .

Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee,

Fantastic! Perfect! In fact very versatile.

Thanks for the excellent work.

 

You're very welcome teknomatika, I enjoyed writing this one :)

teknomatika Rising Star

teknomatika

Posted
  • Author
Posted
@ teknomatika

Just a thought , I don't think it's a good idea to quote every reply with all it codes so that would increase the size of the thread and would be boring to scroll too long for every reply .

 

Tharwat, you are right. Sorry for the inconvenience. I'll take it into consideration.

Tharwat Grand Master

Tharwat

Posted
Posted
Tharwat, you are right. Sorry for the inconvenience. I'll take it into consideration.

 

Not a problem at all , and thanks for taking the tip so friendly :)

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...