Jump to content

Moving Text Block to adjacent point

archipelag0

By archipelag0
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

asdfgh Contributor

asdfgh

Posted
Posted
18 hours ago, BIGAL said:

If you look into the command in VL lisp getclosestpointto that is the answer for this problem, just select the 3 objects, point, line & text. then based on the Line get the new point and move the text and object to the respective point.

 

The line with 10 may end up with the point on top of the 10.

 

Bit busy at moment will add to To do but some one else may jump in.

thank you for your reply,

isn't there a way to select all the text, lines & points in the drawing at once ? as i have hundreds of this case 

Link to comment
Share on other sites
  • Replies 47
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    11

  • BIGAL

    6

  • asdfgh

    5

  • HaroldA

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Lee Mac
Lee Mac

Why does the LISP have to be recursive?   Give this a try:   ;; Text 2 Point - Lee Mac 2012 ;; Prompts for a selection of Text and Point entities and moves ;; each Text entity to

Lee Mac
Lee Mac

Here's a quick modification - ;; Text 2 Point - Lee Mac 2012 ;; Prompts for a selection of Text and Point entities and moves ;; each Text entity to the nearest (2D distance) Point entity in the

GTVic
GTVic

Someone asked me for a modified version so I'm posting it here with thanks to Lee Mac. prompts for maximum movement distance allows MTEXT and Civil 3D Cogo Points only modifies g

Posted Images

BIGAL Grand Master

BIGAL

Posted
Posted

Can be done, probably use the text as the search point then look for a Line and a point. Only issue is if point is to far away.

 

Did a bit of testing not finished yet been busy.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Try this 

(defun c:wow ( / ss ss2 pt pt2 pt3 pt4 pt5 obj1 obj2 obj3 pttxt getline getpt)

(defun getline (pt1 / pt2 pt3 pt4 pt5)
  (setq pt2 (polar pt1 (* 0.25 pi) 700))
  (setq pt3 (polar pt1 (* 0.75 pi) 700))
  (setq pt4 (polar pt1 (* 1.25 pi) 700))
  (setq pt5 (polar pt1 (* 1.75 pi) 700))
  (setq ss2 (ssget "F" (list pt2 pt3 pt4 pt5 pt2) (list (cons 0  "LINE"))))
  (setq obj2 (vlax-ename->vla-object (ssname ss2 0)))
  (setq pt2 (vlax-curve-getclosestpointto obj2 pttxt))
  (vla-move  obj1 (vlax-3d-point pttxt) (vlax-3d-point pt2))
)

(defun getpt (pt1 / pt2 pt3 pt4 pt5)
  (setq pt2 (polar pt1 (* 0.25 pi) 700))
  (setq pt3 (polar pt1 (* 0.75 pi) 700))
  (setq pt4 (polar pt1 (* 1.25 pi) 700))
  (setq pt5 (polar pt1 (* 1.75 pi) 700))
  (setq ss2 (ssget "CP" (list pt2 pt3 pt4 pt5 pt2) (list (cons 0  "POINT"))))
  (setq obj3 (vlax-ename->vla-object (ssname ss2 0)))
  (setq pt (vlax-get obj3 'coordinates))
  (setq pt2 (vlax-curve-getclosestpointto obj2 pt))
  (vla-move  obj3 (vlax-3d-point pt) (vlax-3d-point pt2))
)
(prompt "\nSelect the text ")
(setq ss (ssget '((0 . "text"))))
(if (= (sslength ss) nil)
  (progn (alert "No objects selected\n will now exit ")(exit))
  (progn
  (repeat (setq x (sslength ss))
    (setq obj1 (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
    (setq pttxt (vlax-get obj1 'InsertionPoint))
    (getline pttxt)
   (getpt pttxt)
  )
  )
)

(princ)
)

 

Link to comment
Share on other sites
asdfgh Contributor

asdfgh

Posted
Posted
13 hours ago, BIGAL said:

Try this 

(defun c:wow ( / ss ss2 pt pt2 pt3 pt4 pt5 obj1 obj2 obj3 pttxt getline getpt)

(defun getline (pt1 / pt2 pt3 pt4 pt5)
  (setq pt2 (polar pt1 (* 0.25 pi) 700))
  (setq pt3 (polar pt1 (* 0.75 pi) 700))
  (setq pt4 (polar pt1 (* 1.25 pi) 700))
  (setq pt5 (polar pt1 (* 1.75 pi) 700))
  (setq ss2 (ssget "F" (list pt2 pt3 pt4 pt5 pt2) (list (cons 0  "LINE"))))
  (setq obj2 (vlax-ename->vla-object (ssname ss2 0)))
  (setq pt2 (vlax-curve-getclosestpointto obj2 pttxt))
  (vla-move  obj1 (vlax-3d-point pttxt) (vlax-3d-point pt2))
)

(defun getpt (pt1 / pt2 pt3 pt4 pt5)
  (setq pt2 (polar pt1 (* 0.25 pi) 700))
  (setq pt3 (polar pt1 (* 0.75 pi) 700))
  (setq pt4 (polar pt1 (* 1.25 pi) 700))
  (setq pt5 (polar pt1 (* 1.75 pi) 700))
  (setq ss2 (ssget "CP" (list pt2 pt3 pt4 pt5 pt2) (list (cons 0  "POINT"))))
  (setq obj3 (vlax-ename->vla-object (ssname ss2 0)))
  (setq pt (vlax-get obj3 'coordinates))
  (setq pt2 (vlax-curve-getclosestpointto obj2 pt))
  (vla-move  obj3 (vlax-3d-point pt) (vlax-3d-point pt2))
)
(prompt "\nSelect the text ")
(setq ss (ssget '((0 . "text"))))
(if (= (sslength ss) nil)
  (progn (alert "No objects selected\n will now exit ")(exit))
  (progn
  (repeat (setq x (sslength ss))
    (setq obj1 (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
    (setq pttxt (vlax-get obj1 'InsertionPoint))
    (getline pttxt)
   (getpt pttxt)
  )
  )
)

(princ)
)

 

it worked so good, but the problem is that this code moves the point to the lines. Isn't there anyway that the lines to be moved to the points ? as the points coordinates are important

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

 

Ok you should have made that clear at start, another problem is you have 2 lines not 1 so the end points need to be used of the lines. Can we erase the 2 lines and make 1 new one ? Just looked at image, so was not obvious you wanted point to control.

 

In terms of method its use Point instead of Text to do searching. 

Edited by BIGAL
Link to comment
Share on other sites
asdfgh Contributor

asdfgh

Posted
Posted
5 hours ago, BIGAL said:

 

Ok you should have made that clear at start, another problem is you have 2 lines not 1 so the end points need to be used of the lines. Can we erase the 2 lines and make 1 new one ? Just looked at image, so was not obvious you wanted point to control.

 

In terms of method its use Point instead of Text to do searching. 

Sorry if i wasn't clear enough, my bad. I want the lines and texts to be moved to the points, for the lines actually they are two lines and unfortunately they should be 2 lines (as further i will export the 2 lines coordinates to excel) 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

"2 lines coordinates to excel" as they have a common pt is it not 3 points ?

 

You can be lucky just did this for someone.  

; export line details to excel.
; By AlanH July 2023


(defun c:lexcel ( / putcell myxl ss row )

(defun putcell (cellname val1 / myrange)
(setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
(vlax-put-property myRange 'Value2 val1)
)

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(alert "\nPlease select all lines")
(setq ss (ssget (list (cons 0 "LINE"))))

(if (= ss nil)
(progn 
  (alert "no line objects selected \n will exit now ")
  (exit)
)
(progn
(setq row 1)
(putcell (strcat "A" (rtos row 2 0)) "Line No.")
(putcell (strcat "B" (rtos row 2 0)) "Handle")
(putcell (strcat "C" (rtos row 2 0)) "Startx")
(putcell (strcat "D" (rtos row 2 0)) "Starty")
(putcell (strcat "E" (rtos row 2 0)) "Endx")
(putcell (strcat "F" (rtos row 2 0)) "Endy")
(putcell (strcat "G" (rtos row 2 0)) "Length")

(setq row 2)
(repeat (setq k (sslength ss))
  (setq ent (entget (ssname ss (setq k (1- k)))))
  (setq start (cdr (assoc 10 ent)))
  (setq end (cdr (assoc 11 ent)))
  (setq hand (cdr (assoc 5 ent)))
  (setq dist (distance start end))
  (setq lay (cdr (assoc 8 ent)))
  (putcell (strcat "A" (rtos row 2 0)) (rtos (- row 1) 2 0))
  (putcell (strcat "B" (rtos row 2 0)) hand)
  (putcell (strcat "C" (rtos row 2 0)) (rtos (car start) 2 3))
  (putcell (strcat "D" (rtos row 2 0)) (rtos (cadr start) 2 3))
  (putcell (strcat "E" (rtos row 2 0)) (rtos (car end) 2 3))
  (putcell (strcat "F" (rtos row 2 0)) (rtos (cadr end) 2 3))
  (putcell (strcat "G" (rtos row 2 0)) (rtos dist 2 3))
  (setq row (1+ row))
)
)
)

(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))

(princ)
)
(c:lexcel)

  

; export line details to excel.
; By AlanH July 2023


(defun c:lexcel2 ( / putcell myxl ss row )
; put a value into a excel cell
(defun putcell (cellname val1 / myrange)
(setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
(vlax-put-property myRange 'Value2 val1)
)
; is excel open and open it anyway
(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ; add a new workbook
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(alert "\nPlease select all lines")
(setq ss (ssget (list (cons 0 "LINE")))) ; select all lines through manual select yes can do (ssget "x" gets all

(if (= ss nil)
(progn 
  (alert "no line objects selected \n will exit now ")
  (exit) ; hard exit out of program
)
(progn
(setq row 1) ; row 1 in excel
(putcell (strcat "A" (rtos row 2 0)) "Line No.") ; put values into 1st row excel
(putcell (strcat "B" (rtos row 2 0)) "Handle") ; rtos real to string 2 engineering 3 decimal places.
(putcell (strcat "C" (rtos row 2 0)) "Startx")
(putcell (strcat "D" (rtos row 2 0)) "Starty")
(putcell (strcat "E" (rtos row 2 0)) "Endx")
(putcell (strcat "F" (rtos row 2 0)) "Endy")
(putcell (strcat "G" (rtos row 2 0)) "Length")

(setq row 2)
(repeat (setq k (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq k (- k 1))))) ; get items from selection set ussing ssname 
  (setq start (vlax-curve-getstartPoint obj)) ; start point
  (setq end (vlax-curve-getEndPoint obj))
  (setq hand (vlax-get obj 'Handle)) ; handle
  (setq dist (vlax-get obj 'Length))
  (setq lay (vlax-get obj 'layer))
  ; put values into excel
  ; can use a double loop so Col=1 =2 =3 etc rather than simple A B C
  ; (strcat "A" (rtos row 2 0)) = "A1"
  (putcell (strcat "A" (rtos row 2 0)) (rtos (- row 1) 2 0)) ; row is 2 but line is 1
  (putcell (strcat "B" (rtos row 2 0)) hand) 
  (putcell (strcat "C" (rtos row 2 0)) (rtos (car start) 2 3))
  (putcell (strcat "D" (rtos row 2 0)) (rtos (cadr start) 2 3))
  (putcell (strcat "E" (rtos row 2 0)) (rtos (car end) 2 3))
  (putcell (strcat "F" (rtos row 2 0)) (rtos (cadr end) 2 3))
  (putcell (strcat "G" (rtos row 2 0)) (rtos dist 2 3))
  (setq row (1+ row)) ; next row
)
)
)
; release xl object
(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))

(princ)
)
(c:lexcel2)

 

Edited by BIGAL
Link to comment
Share on other sites
asdfgh Contributor

asdfgh

Posted
Posted
22 minutes ago, BIGAL said:

"2 lines coordinates to excel" as they have a common pt is it not 3 points ?

 

You can be lucky just did this for someone.  

; export line details to excel.
; By AlanH July 2023


(defun c:lexcel ( / putcell myxl ss row )

(defun putcell (cellname val1 / myrange)
(setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
(vlax-put-property myRange 'Value2 val1)
)

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(alert "\nPlease select all lines")
(setq ss (ssget (list (cons 0 "LINE"))))

(if (= ss nil)
(progn 
  (alert "no line objects selected \n will exit now ")
  (exit)
)
(progn
(setq row 1)
(putcell (strcat "A" (rtos row 2 0)) "Line No.")
(putcell (strcat "B" (rtos row 2 0)) "Handle")
(putcell (strcat "C" (rtos row 2 0)) "Startx")
(putcell (strcat "D" (rtos row 2 0)) "Starty")
(putcell (strcat "E" (rtos row 2 0)) "Endx")
(putcell (strcat "F" (rtos row 2 0)) "Endy")
(putcell (strcat "G" (rtos row 2 0)) "Length")

(setq row 2)
(repeat (setq k (sslength ss))
  (setq ent (entget (ssname ss (setq k (1- k)))))
  (setq start (cdr (assoc 10 ent)))
  (setq end (cdr (assoc 11 ent)))
  (setq hand (cdr (assoc 5 ent)))
  (setq dist (distance start end))
  (setq lay (cdr (assoc 8 ent)))
  (putcell (strcat "A" (rtos row 2 0)) (rtos (- row 1) 2 0))
  (putcell (strcat "B" (rtos row 2 0)) hand)
  (putcell (strcat "C" (rtos row 2 0)) (rtos (car start) 2 3))
  (putcell (strcat "D" (rtos row 2 0)) (rtos (cadr start) 2 3))
  (putcell (strcat "E" (rtos row 2 0)) (rtos (car end) 2 3))
  (putcell (strcat "F" (rtos row 2 0)) (rtos (cadr end) 2 3))
  (putcell (strcat "G" (rtos row 2 0)) (rtos dist 2 3))
  (setq row (1+ row))
)
)
)

(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))

(princ)
)
(c:lexcel)

  

; export line details to excel.
; By AlanH July 2023


(defun c:lexcel2 ( / putcell myxl ss row )
; put a value into a excel cell
(defun putcell (cellname val1 / myrange)
(setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
(vlax-put-property myRange 'Value2 val1)
)
; is excel open and open it anyway
(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ; add a new workbook
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(alert "\nPlease select all lines")
(setq ss (ssget (list (cons 0 "LINE")))) ; select all lines through manual select yes can do (ssget "x" gets all

(if (= ss nil)
(progn 
  (alert "no line objects selected \n will exit now ")
  (exit) ; hard exit out of program
)
(progn
(setq row 1) ; row 1 in excel
(putcell (strcat "A" (rtos row 2 0)) "Line No.") ; put values into 1st row excel
(putcell (strcat "B" (rtos row 2 0)) "Handle") ; rtos real to string 2 engineering 3 decimal places.
(putcell (strcat "C" (rtos row 2 0)) "Startx")
(putcell (strcat "D" (rtos row 2 0)) "Starty")
(putcell (strcat "E" (rtos row 2 0)) "Endx")
(putcell (strcat "F" (rtos row 2 0)) "Endy")
(putcell (strcat "G" (rtos row 2 0)) "Length")

(setq row 2)
(repeat (setq k (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq k (- k 1))))) ; get items from selection set ussing ssname 
  (setq start (vlax-curve-getstartPoint obj)) ; start point
  (setq end (vlax-curve-getEndPoint obj))
  (setq hand (vlax-get obj 'Handle)) ; handle
  (setq dist (vlax-get obj 'Length))
  (setq lay (vlax-get obj 'layer))
  ; put values into excel
  ; can use a double loop so Col=1 =2 =3 etc rather than simple A B C
  ; (strcat "A" (rtos row 2 0)) = "A1"
  (putcell (strcat "A" (rtos row 2 0)) (rtos (- row 1) 2 0)) ; row is 2 but line is 1
  (putcell (strcat "B" (rtos row 2 0)) hand) 
  (putcell (strcat "C" (rtos row 2 0)) (rtos (car start) 2 3))
  (putcell (strcat "D" (rtos row 2 0)) (rtos (cadr start) 2 3))
  (putcell (strcat "E" (rtos row 2 0)) (rtos (car end) 2 3))
  (putcell (strcat "F" (rtos row 2 0)) (rtos (cadr end) 2 3))
  (putcell (strcat "G" (rtos row 2 0)) (rtos dist 2 3))
  (setq row (1+ row)) ; next row
)
)
)
; release xl object
(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))

(princ)
)
(c:lexcel2)

 

Thank you so much, these lisp works perfect. You are really genius. I will export lines to excel but first i need them to be aligned or moved to the points :D 

Link to comment
Share on other sites

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...