Pugazh Posted October 9, 2019 Share Posted October 9, 2019 Hello Everyone ! The posted code is working fine as per the attached image. They text are move follow with green line direction but I need move text follow with magenta line direction in selected line or Polyline. Can anyone help me! Code : (Defun c:alt (/ li txts e) (if (and (princ "\nSelect Line for Alignment") (setq li (ssget "_:L" '((0 . "LINE")))) (princ "\nSelect Texts to Align") (setq txts (ssget "_:L" '((0 . "TEXT,MTEXT"))))) (repeat (sslength txts) (vla-move (setq e (vlax-ename->vla-object (ssname txts 0))) (vla-get-insertionpoint e) (vlax-3d-point (vlax-curve-getclosestpointto (ssname li 0) (vlax-get e 'insertionpoint))) ) (ssdel (ssname txts 0) txts) ) ) (princ) ) (vl-load-com) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 10, 2019 Share Posted October 10, 2019 (edited) Are you happy with move based on angle of text ? This would use a xline and intersectwith ; By Alan H Oct 2019 ; moves text along text angle to a *line (vl-load-com) (defun c:pushtxt ( / ss ang obj obj2 obj4 pt1 pt2 pt3 ent) (setq obj (vlax-ename->vla-object (car (entsel "pick Line ")))) (setq ss (ssget (list (cons 0 "*text")))) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (setq obj2 (vlax-ename->vla-object ent )) (setq Pt1 (vlax-get Obj2 'Insertionpoint)) (setq ang (vlax-get Obj2 'rotation)) (setq pt3 (polar pt1 ang 10)) (command "xline" pt1 pt3 "") (setq obj4 (vlax-ename->vla-object (entlast))) (setq intpt (vlax-invoke obj 'intersectWith obj4 acExtendboth)) (vla-delete obj4) (command "move" ent "" pt1 intpt) ) ) (c:pushtxt) Edited October 11, 2019 by BIGAL 1 Quote Link to comment Share on other sites More sharing options...
dlanorh Posted October 10, 2019 Share Posted October 10, 2019 As the OP wants to move to a line or pline I can see a problem arising if the xline cuts the pline more than once, when intpt will become a list min length 6 (2 points), so you would have to find the nearest intersection point. 1 Quote Link to comment Share on other sites More sharing options...
Pugazh Posted October 10, 2019 Author Share Posted October 10, 2019 @BIGAL No not working Quote Link to comment Share on other sites More sharing options...
dlanorh Posted October 10, 2019 Share Posted October 10, 2019 1 hour ago, Pugazh said: @BIGAL No not working How is it not working? What error message are you getting? Are you trying to use this with a polyline or a line? If with a polyline try it with a line. Is the visual lisp arx loaded? If not put (vl-load-com) at the top of the file and try again 1 Quote Link to comment Share on other sites More sharing options...
Pugazh Posted October 10, 2019 Author Share Posted October 10, 2019 @dlanorh Yeah i'm try with line but they text are not move in line. I got some error See the attached file . Quote Link to comment Share on other sites More sharing options...
dlanorh Posted October 10, 2019 Share Posted October 10, 2019 10 hours ago, Pugazh said: @dlanorh Yeah i'm try with line but they text are not move in line. I got some error See the attached file . Try this (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) ;; Move Text to Line along text rotation (defun c:MT2L ( / *error* c_doc c_spc l_obj ent e_lst ss t_obj i_pt t_rot x_obj x_pts s_d x_pt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg))) (princ) );end_defun *error* (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (while (not l_obj) (setq ent (car (entsel "\nSelect Line : ")) e_lst (entget ent) );end_setq (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent))) );end_while (setq ss (ssget '((0 . "*TEXT")))) (repeat (setq cnt (sslength ss)) (setq t_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))) i_pt (vlax-get t_obj 'insertionpoint) t_rot (vlax-get t_obj 'rotation) x_obj (vlax-invoke c_spc 'addxline i_pt (polar i_pt t_rot 1.0)) x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3) s_d 1.0e200 );end_setq (cond ( (> (length x_pts) 1) (foreach pt x_pts (if (< (distance pt i_pt) s_d) (setq x_pt pt s_d (distance pt i_pt))))) (t (setq x_pt (car x_pts))) );end_cond (vlax-invoke t_obj 'move i_pt x_pt) (vla-delete x_obj) );end_repeat (princ) );end_defun It will move the text to the nearest intersection (if more than 1) using the text angle. See attached dwg MT2L.dwg 1 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 11, 2019 Share Posted October 11, 2019 (edited) I just tested again and working fine is the angle of the text such that a intersection point is not visually calculated ? This will force a calculation extending lines replaced in code above (setq intpt (vlax-invoke obj 'intersectWith obj4 acExtendboth)) Edited October 11, 2019 by BIGAL 1 Quote Link to comment Share on other sites More sharing options...
Pugazh Posted October 12, 2019 Author Share Posted October 12, 2019 Thank you so much!! yeah both code are now working fine Cheers @BIGAL @dlanorh Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted October 16, 2019 Share Posted October 16, 2019 (edited) another by math algorithm & entmod without 'vla-move' & 'vlax-intersectwith' select texts then pick a line (defun c:test (/ ok ss en enx np l x y i p) (if (and (princ "\nSelect Texts to Align ") (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT")))) (setq en (car (entsel "\nSelect LINE.."))) (setq enx (entget en)) (= (cdr (assoc 0 enx)) "LINE") (setq l (mapcar ''((x) (cdr (assoc x enx))) '(10 11) ) x (vl-sort l ''((a b) (<= (car a) (car b)))) y (vl-sort l ''((a b) (<= (cadr a) (cadr b)))) ) ) (progn (repeat (setq i (sslength ss)) (setq enx (entget (ssname ss (setq i (1- i))))) (setq c (if (or (= (cdr (assoc 0 enx)) "MTEXT") (equal (setq p (cdr (assoc 11 enx))) '(0.0 0.0 0.0) 1e-7) ) 10 11 ) ) (setq p (cdr (assoc c enx))) (and (setq ok (or (setq np (hp:IntersOnX p x)) ;(setq np (hp:IntersOnY p y)) ) ) (entmod (subst (cons c np) (cons c p) enx)) (grdraw (trans np 0 1) (trans p 0 1) 2) ) ) (if (not ok) (princ "\nSorry.. out of range!") ) ) (princ "\nOops.. please retry ") ) (princ) ) (defun hp:IntersOnX (p l / xy) ;hanhphuc (setq xy '((x)(mapcar '* x '(1.0 1.0))) p (xy p)) (cadr (assoc T (cons (list (vl-some ''((x)(equal p (xy x) 1e-4)) l) p) (mapcar ''((a b / d )(setq d (xy (mapcar '- b a))) (list (<= (car a) (car p) (car b)) (list (car p) (+ (cadr a) (* (- (car p) (car a)) (if (vl-some 'zerop d) 0. (/ 1. (apply '/ d )))))) ) ) l (cdr l) ) ) ) ) ) Edited October 16, 2019 by hanhphuc 1 Quote Link to comment Share on other sites More sharing options...
Pugazh Posted October 17, 2019 Author Share Posted October 17, 2019 Thank you so much!! @hanhphuc Quote Link to comment Share on other sites More sharing options...
Pugazh Posted October 17, 2019 Author Share Posted October 17, 2019 On 11/10/2019 at 00:26, dlanorh said: Try this (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) ;; Move Text to Line along text rotation (defun c:MT2L ( / *error* c_doc c_spc l_obj ent e_lst ss t_obj i_pt t_rot x_obj x_pts s_d x_pt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg))) (princ) );end_defun *error* (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (while (not l_obj) (setq ent (car (entsel "\nSelect Line : ")) e_lst (entget ent) );end_setq (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent))) );end_while (setq ss (ssget '((0 . "*TEXT")))) (repeat (setq cnt (sslength ss)) (setq t_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))) i_pt (vlax-get t_obj 'insertionpoint) t_rot (vlax-get t_obj 'rotation) x_obj (vlax-invoke c_spc 'addxline i_pt (polar i_pt t_rot 1.0)) x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3) s_d 1.0e200 );end_setq (cond ( (> (length x_pts) 1) (foreach pt x_pts (if (< (distance pt i_pt) s_d) (setq x_pt pt s_d (distance pt i_pt))))) (t (setq x_pt (car x_pts))) );end_cond (vlax-invoke t_obj 'move i_pt x_pt) (vla-delete x_obj) );end_repeat (princ) );end_defun It will move the text to the nearest intersection (if more than 1) using the text angle. See attached dwg MT2L.dwg 61.96 kB · 5 downloads Hi @dlanorh, I have to add some changes can you please help me!! Above this code after creating xline, i want to move or offset xline (clockwise direction) distance is taken from dimscale. Quote Link to comment Share on other sites More sharing options...
dlanorh Posted October 18, 2019 Share Posted October 18, 2019 Sorry I can't help at the moment as I am away and I don't have any version of AutoCAD etc with me. Will be back at the end of next week. 1 Quote Link to comment Share on other sites More sharing options...
Pugazh Posted October 19, 2019 Author Share Posted October 19, 2019 20 hours ago, dlanorh said: Sorry I can't help at the moment as I am away and I don't have any version of AutoCAD etc with me. Will be back at the end of next week. i will be waiting Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.