Move text to nearest object

April 29

Hi anybody can help

i have many multiple text and those text to be combine with leader for combining text and leader i use lsp but lisp only work when text and leader are in same point, one more scenario is after joining leader and text those also fall near by location of block insert point but i want leader head to be insert with block for more i was givin dwg file

Drawing3.dwg

Edited April 29 by pmadhwal7

April 30

Just a question why are they wrong ? Going back a step how is leader made & how is text made. Does not make much sense that its being done incorrectly. Sounds like its sloppy drafting.

April 30

49 minutes ago, BIGAL said:

Just a question why are they wrong ? Going back a step how is leader made & how is text made. Does not make much sense that its being done incorrectly. Sounds like its sloppy drafting.

actually those text are placed from excel sheet, firstly i was export those pole coordinate to excel and when i got coordinate of pole i just serialized them and paste their type from other excel to exported excel leader comes from another dwg and placed as per block location then paste text from excel sheet and join both

April 30

You can create a text object with one command. If you want a multiline text, you have to do some work, but you get more control.

Look into the DXF codes. You can create a multitext with the entmake command using a list of these codes in this order:

Entity Type - (0 . "MTEXT")

Object Type - (100 . "AcDbEntity")

Layer - (8 . <layer name>)

Object Subtype - (100 . "AcDbMText")

Location - (10 . <point>)

Direction of UCS - (11 . (getvar 'ucsxdir))

Translation Matrix - (210 . '(0 0 1) 1 0 T)

Text Height - (40 . <height>)

Justification - (71 . <insertion point, see below>)

Contents - (1 . <text>)

Style - (7 . <style>)

Rotation - (50 . <angle in radians>)

Fill - (90 . <code, see below>)

Background Color (pick one) - (63 . <color index>) / (420-429 . <RGB color>) / (430 . <color name>)

Fill Box Scale (optional) - (45 . <margin>)

Transparency - (441 . 0)

Some notes:

The Justification value is an integer: 1=top left, 2=top center, 3=top right, 4=middle left, etc.

You can omit the Style code, it will default to Standard.

The Fill code is the sum of these integers: 0=none, 1=background, 2=drawing window color.

For the multileader options, here's another set of codes. I haven't had time to figure out exactly how these work.

I know, it's a lot of information. If you have questions, post a response.

May 1

Ok sounds like you need to go back to the Excel data insert the pole block, pause for leader direction then go to next row. If you Auto insert and make a leader the direction will be fixed which may be ok.

Post EXCEL.

May 1

12 hours ago, BIGAL said:

Ok sounds like you need to go back to the Excel data insert the pole block, pause for leader direction then go to next row. If you Auto insert and make a leader the direction will be fixed which may be ok.

Post EXCEL.

Dwg and excel are attached

Pole.dwg Pole.xlsx

May 2

Ok no probs insert pole and Number. Then do a leader with fixed offsets for moment. Just read the XLS values.

Give this a try. 1st thing is made a new dwg called poles which has the pole blocks in it, if you use a template with those blocks will still work. Edit the location of POLE.DWG so missing blocks are found.

Just open the correct excel file before running.

; https://www.cadtutor.net/forum/topic/84287-move-text-to-nearest-object/

; pole xls pole.dwg

(defun c:poles ( / st end getrangexl ColumnRow Alpha2Number oldsnap row col num)

; thanks to Lee-mac for this defun 
; www.lee-mac.com
; 44 is comma 9 is tab 34 is space 58 is colon
(defun _csv->lst58 ( str / pos )
	(if (setq pos (vl-string-position 58 str))
		(cons (substr str 1 pos) (_csv->lst58 (substr str (+ pos 2))))
		(list str)
    )
)
; get active range selected
(defun getrangexl ( / lst UR CR RADD )
(setq lst '())
(setq UR (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "UsedRange"))
(setq CR (vlax-get-property UR "CurrentRegion"))
(setq RADD (vlax-get-property CR "Address"))
(setq cnt (vlax-get-property CR  "Count"))
(setq lst (_csv->lst58 radd))
(setq st (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 0 lst) )))
(setq end (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 1 lst) )))
(setq st  (columnrow st))
(setq end  (columnrow end))
(princ st)
(princ "\n")
(princ end)
)

 ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;default to "A1" if there's a problem
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
  (setq Column$ "")
  (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
    (setq Column$ (strcat Column$ Char$)
          Cell$ (substr Cell$ 2)
    )
  )
  (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
    (list (Alpha2Number Column$) Row#)
    '(1 1)
  )
)

; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    )
  )
)

;;	Thanks to fixo			;;
(defun getcell2 (row column / )
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
(setq cell (vlax-get (vlax-variant-value  (vlax-get-property cells "Item" row column)) 'value))
)

(setq myxl (vlax-get-object "Excel.Application"))
(if (= myxl nil)
  (progn ( alert "Please open excel file to use \n\nwill now exit please run again")(exit))
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(setvar 'attreq 0)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(if (tblsearch "Block" "EXISTING_POLE")
(command "-insert" "d:\\acadtemp\\POLES" "0,0" 1 1 0)
(command "erase" (entlast) "")
)

(setvar 'textstyle "TVIPL_Dimension")
(command "dimstyle" "R" "TVIPL Dim")

(getrangexl)
; 1st row is header so add 1
(setq row (+ (car st) 1) col (car end) num (cadr end))
(repeat (- num 1)
  (setq pnum (rtos (getcell2 row 2) 2 0)
    x (getcell2 row 3)
    y (getcell2 row 4)
	pt (list x y)
    ptype (getcell2 row 9)
  )
  (setq row (1+ row))
  (cond
    ((= ptype "EXISTING POLE")(command "-insert" "EXISTING_POLE" pt 1 1 0)(command "text" pt 2.0 0.0 pnum))
    ((wcmatch Ptype  "*NEW POLE*")(command "-insert" "ADSS Pole(new)" pt 1 1 0)(command "text" pt 2.0 0.0 pnum))
    ((princ "\nUnknown pole name so skipping "))
  )
  (command "leader" pt (mapcar '+ pt (list 3.5 -3.5 0.0)) "A" ptype "")
)

(setvar 'attreq 1)
(setvar 'osmode oldsnap)
(princ)

) ; defun

poles.dwg

Edited May 2 by BIGAL

May 2

31 minutes ago, BIGAL said:

Ok no probs insert pole and Number. Then do a leader with fixed offsets for moment. Just read the XLS values.

Give this a try. 1st thing is made a new dwg called poles which has the pole blocks in it, if you use a template with those blocks will still work. Edit the location of POLE.DWG so missing blocks are found.

Just open the correct excel file before running.

; https://www.cadtutor.net/forum/topic/84287-move-text-to-nearest-object/

; pole xls pole.dwg

(defun c:poles ( / st end getrangexl ColumnRow Alpha2Number oldsnap row col num)

; thanks to Lee-mac for this defun 
; www.lee-mac.com
; 44 is comma 9 is tab 34 is space 58 is colon
(defun _csv->lst58 ( str / pos )
	(if (setq pos (vl-string-position 58 str))
		(cons (substr str 1 pos) (_csv->lst58 (substr str (+ pos 2))))
		(list str)
    )
)
; get active range selected
(defun getrangexl ( / lst UR CR RADD )
(setq lst '())
(setq UR (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "UsedRange"))
(setq CR (vlax-get-property UR "CurrentRegion"))
(setq RADD (vlax-get-property CR "Address"))
(setq cnt (vlax-get-property CR  "Count"))
(setq lst (_csv->lst58 radd))
(setq st (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 0 lst) )))
(setq end (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 1 lst) )))
(setq st  (columnrow st))
(setq end  (columnrow end))
(princ st)
(princ "\n")
(princ end)
)

 ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;default to "A1" if there's a problem
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
  (setq Column$ "")
  (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
    (setq Column$ (strcat Column$ Char$)
          Cell$ (substr Cell$ 2)
    )
  )
  (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
    (list (Alpha2Number Column$) Row#)
    '(1 1)
  )
)

; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    )
  )
)

;;	Thanks to fixo			;;
(defun getcell2 (row column / )
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
(setq cell (vlax-get (vlax-variant-value  (vlax-get-property cells "Item" row column)) 'value))
)

(setq myxl (vlax-get-object "Excel.Application"))
(if (= myxl nil)
  (progn ( alert "Please open excel file to use \n\nwill now exit please run again")(exit))
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(setvar 'attreq 0)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(if (tblsearch "Block" "EXISTING_POLE")
(command "-insert" "d:\\acadtemp\\POLES" "0,0" 1 1 0)
(command "erase" (entlast) "")
)

(setvar 'textstyle "TVIPL_Dimension")
(command "dimstyle" "R" "TVIPL Dim")

(getrangexl)
; 1st row is header so add 1
(setq row (+ (car st) 1) col (car end) num (cadr end))
(repeat (- num 1)
  (setq pnum (rtos (getcell2 row 2) 2 0)
    x (getcell2 row 3)
    y (getcell2 row 4)
	pt (list x y)
    ptype (getcell2 row 9)
  )
  (setq row (1+ row))
  (cond
    ((= ptype "EXISTING POLE")(command "-insert" "EXISTING_POLE" pt 1 1 0)(command "text" pt 2.0 0.0 pnum))
    ((wcmatch Ptype  "*NEW POLE*")(command "-insert" "ADSS Pole(new)" pt 1 1 0)(command "text" pt 2.0 0.0 pnum))
    ((princ "\nUnknown pole name so skipping "))
  )
  (command "leader" pt (mapcar '+ pt (list 3.5 -3.5 0.0)) "A" ptype "")
)

(setvar 'attreq 1)
(setvar 'osmode oldsnap)
(princ)

) ; defun

poles.dwg 26.34 kB · 0 downloads

On 4/30/2024 at 6:23 PM, CyberAngel said:

You can create a text object with one command. If you want a multiline text, you have to do some work, but you get more control.

Look into the DXF codes. You can create a multitext with the entmake command using a list of these codes in this order:

Entity Type - (0 . "MTEXT")

Object Type - (100 . "AcDbEntity")

Layer - (8 . <layer name>)

Object Subtype - (100 . "AcDbMText")

Location - (10 . <point>)

Direction of UCS - (11 . (getvar 'ucsxdir))

Translation Matrix - (210 . '(0 0 1) 1 0 T)

Text Height - (40 . <height>)

Justification - (71 . <insertion point, see below>)

Contents - (1 . <text>)

Style - (7 . <style>)

Rotation - (50 . <angle in radians>)

Fill - (90 . <code, see below>)

Background Color (pick one) - (63 . <color index>) / (420-429 . <RGB color>) / (430 . <color name>)

Fill Box Scale (optional) - (45 . <margin>)

Transparency - (441 . 0)

Some notes:

The Justification value is an integer: 1=top left, 2=top center, 3=top right, 4=middle left, etc.

You can omit the Style code, it will default to Standard.

The Fill code is the sum of these integers: 0=none, 1=background, 2=drawing window color.

For the multileader options, here's another set of codes. I haven't had time to figure out exactly how these work.

I know, it's a lot of information. If you have questions, post a response.

hi CyberAngel how to use this?

May 2

On 4/30/2024 at 6:23 PM, CyberAngel said:

You can create a text object with one command. If you want a multiline text, you have to do some work, but you get more control.

Look into the DXF codes. You can create a multitext with the entmake command using a list of these codes in this order:

Entity Type - (0 . "MTEXT")

Object Type - (100 . "AcDbEntity")

Layer - (8 . <layer name>)

Object Subtype - (100 . "AcDbMText")

Location - (10 . <point>)

Direction of UCS - (11 . (getvar 'ucsxdir))

Translation Matrix - (210 . '(0 0 1) 1 0 T)

Text Height - (40 . <height>)

Justification - (71 . <insertion point, see below>)

Contents - (1 . <text>)

Style - (7 . <style>)

Rotation - (50 . <angle in radians>)

Fill - (90 . <code, see below>)

Background Color (pick one) - (63 . <color index>) / (420-429 . <RGB color>) / (430 . <color name>)

Fill Box Scale (optional) - (45 . <margin>)

Transparency - (441 . 0)

Some notes:

The Justification value is an integer: 1=top left, 2=top center, 3=top right, 4=middle left, etc.

You can omit the Style code, it will default to Standard.

The Fill code is the sum of these integers: 0=none, 1=background, 2=drawing window color.

For the multileader options, here's another set of codes. I haven't had time to figure out exactly how these work.

I know, it's a lot of information. If you have questions, post a response.

hi CyberAngel how to use this?

May 2

6 hours ago, pmadhwal7 said:

hi CyberAngel how to use this?

Here's what I did. You may have to adjust the code for your situation, especially if you're creating a multileader.

First, create a prefix and a suffix for the main command string. These items won't change from one instance to the next.

(setq lbprefix (list
    '(0 . "MTEXT") '(100 . "AcDbEntity") (cons 8 (getvar "clayer")) '(100 . "AcDbMText") ))
  (setq lbsuffix (list
    (cons 7 (getvar "textstyle")) '(50 . 0) '(90 . 3) '(63 . 256) '(45 . 1.1) '(441 . 0) ))

Get data from user: pt3, for instance, is the multitext insertion point and ptjustify is the justification code (described above). Do your calculations. Then put it all together.

  (entmake (append
    lbprefix
    (list
      (cons 10 (trans pt3 1 0))   ; location (in current UCS)
      (cons 11 (getvar 'ucsxdir))
      (cons 210 (trans '(0 0 1) 1 0 t))
      (cons 40 lbheight) ; height
      (cons 71 (atoi ptjustify)) ; justification
      (cons 1 lbtxt) ; contents
    )
    lbsuffix
  )) ; end append/entmake

You're constructing a list of dotted pairs and passing it to entmake. It only looks complicated because there are 16 pairs and I split them into three lists.

Tack this onto the code BigAl provided, and you should be well on your way.

Edited May 2 by CyberAngel
changed a word

May 3

20 hours ago, CyberAngel said:
Here's what I did. You may have to adjust the code for your situation, especially if you're creating a multileader.

First, create a prefix and a suffix for the main command string. These items won't change from one instance to the next.
(setq lbprefix (list
    '(0 . "MTEXT") '(100 . "AcDbEntity") (cons 8 (getvar "clayer")) '(100 . "AcDbMText") ))
  (setq lbsuffix (list
    (cons 7 (getvar "textstyle")) '(50 . 0) '(90 . 3) '(63 . 256) '(45 . 1.1) '(441 . 0) ))
Get data from user: pt3, for instance, is the multitext insertion point and ptjustify is the justification code (described above). Do your calculations. Then put it all together.
  (entmake (append
    lbprefix
    (list
      (cons 10 (trans pt3 1 0))   ; location (in current UCS)
      (cons 11 (getvar 'ucsxdir))
      (cons 210 (trans '(0 0 1) 1 0 t))
      (cons 40 lbheight) ; height
      (cons 71 (atoi ptjustify)) ; justification
      (cons 1 lbtxt) ; contents
    )
    lbsuffix
  )) ; end append/entmake
You're constructing a list of dotted pairs and passing it to entmake. It only looks complicated because there are 16 pairs and I split them into three lists.

Tack this onto the code BigAl provided, and you should be well on your way.

hi CyberAngel thanks for your reply please tell me where i can paste those code

Sign In

Move text to nearest object

Recommended Posts

pmadhwal7

BIGAL

pmadhwal7

CyberAngel

BIGAL

pmadhwal7

BIGAL

pmadhwal7

pmadhwal7

CyberAngel

pmadhwal7

Join the conversation

Tutorials

Forums

Activity