scremin Posted June 1, 2013 Posted June 1, 2013 Helo everyone, I'm trying to create a reactor to re-align a text with a modified line. First of all the program create a line and a text that must be put on his mid point. Then I want the reactor to move the text and re-align it every time I change the line. Can anyone help me ? (vl-load-com) ;**************************************************************************** (defun c:line-draw () (setq OSMO (getvar "osmo")) (setvar "osmode" 0) (setq acadDocument (vla-get-activedocument (vlax-get-acad-object))) (setq mspace (vla-get-modelspace acadDocument)) (setq apt (getpoint "Specify First Point: ")) (setq pt (getpoint "Specify next point: " apt)) (setq myLine (vla-addline mspace (vlax-3d-point apt)(vlax-3d-point pt))) (setq ang1 (rtod (angle apt pt))) (if (and (> ang1 90)( (setq ang1 (rtod angle pt apt)) ) (command "text" "J" "MC" (polar apt (dtor ang1) (/ (distance apt pt) 2)) 15 ang1 (rtos (distance apt pt) 2 0)) (setq myText (entlast)) ;(setq textReactor (vlr-object-reactor (list myText) ;"Text Reactor" '((:vlr-modified . update-text)))) (setq lineReactor (vlr-object-reactor (list myLine) "Line Reactor" '((:vlr-modified . print-length)))) (princ) );defun ;****************************************************************************** (defun print-length (notifier-object reactor-object parameter-list) (setq a notifier-object) (setq b reactor-object) (setq ang2 (rtod (angle (assoc 10 (entget a)) (assoc 11 (entget a))))) (if (and (> ang2 90)( (setq ang2 (angle (assoc 11 (entget a)) (assoc 10 (entget a)))) (setq ang2 (dtor ang2)) ) (setq myText-prop (entget myText)) (setq alg-pt (cdr (assoc 11 myText-prop))) ;(cond ; ((vlax-property-available-p notifier-object "Length") ;| (progn |;(setq comp (rtos (vla-get-length notifier-object))) (setq myText-prop (subst (cons 1 (rtos comp 2 0)) (assoc 1 myText-prop) myText-prop)) (setq myText-prop (subst (cons 50 ang2) (assoc 50 myText-prop) myText-prop)) (entmod myText) (setq OSMO (getvar "osmode")) (setvar "osmode" 0) (command "move" myText "" alg-pt (polar (assoc 10 (entget a)) ang2 (/ (vla-get-length a) 2))) (setvar "osmode" OSMO) ; ) ; ) ;cond (princ) );defun ;******************************************************************************* (princ) ;******************************************************************************* (defun rtod (ang) (/ (* ang 180) pi) ) (defun dtor (ang) (/ (* ang pi) 180) ) Quote
marko_ribar Posted June 1, 2013 Posted June 1, 2013 You have some mistakes in your code, but I think you're looking for something similar to this : (defun c:objreac ( / myreactor ) (setq myreactor (vlr-object-reactor (list myline) "Object Reactor : " '((:vlr-modified . print-align-text)))) (vlr-add myreactor) (princ) ) (defun print-align-text ( owner reactor lst / sp ep a d ) (setq sp (vlax-curve-getstartpoint myline)) (setq ep (vlax-curve-getendpoint myline)) (setq a (angle sp ep)) (setq d (distance sp ep)) (vla-put-textstring mytext (rtos d 2 ) (vla-put-alignment mytext acalignmentmiddlecenter) (vla-put-textalignmentpoint mytext (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0)))) (vla-put-rotation mytext a) ) (defun c:myline ( / sp ep a d ) (vl-load-com) (setq sp (getpoint "\nPick start point : ")) (setq ep (getpoint sp "\nPick end point : ")) (setq myline (vla-addline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point sp) (vlax-3d-point ep) ) ) (setq a (angle sp ep)) (setq d (distance sp ep)) (setq mytext (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (rtos d 2 (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0))) (/ d 25.0) ) ) (vla-put-alignment mytext acalignmentmiddlecenter) (vla-put-textalignmentpoint mytext (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0)))) (vla-put-rotation mytext a) (alert "\nType [Command: objreac] to activate object reactor for line entity") (princ) ) It works on my PC... P.S. Please use [noparse] Your code here [/noparse] tags, instead of quote tags for posting your code... M.R. Quote
scremin Posted June 2, 2013 Author Posted June 2, 2013 Thank you very much marko_ribar! Your code Works perfectly fine. But I'm afraid I would like to get a little further with it. Actually the code Works just for the last line created and I wanted that to happen with every line I create in my drawing. Is it possible to do? I'm stucked on multiple variable creation. Thanks in advance. Quote
BlackBox Posted June 2, 2013 Posted June 2, 2013 I think you'd appreciate Lee's myriad Align* Functions. Quote
marko_ribar Posted June 2, 2013 Posted June 2, 2013 Thank you very much marko_ribar! Your code Works perfectly fine. But I'm afraid I would like to get a little further with it. Actually the code Works just for the last line created and I wanted that to happen with every line I create in my drawing. Is it possible to do? I'm stucked on multiple variable creation. Thanks in advance. Something like this : (defun c:objreac ( / myreactor ) (setq myreactor (vlr-object-reactor (mapcar '(lambda (x) (car x)) mylines+mytexts) "Object Reactor : " '((:vlr-modified . print-align-text)))) (vlr-add myreactor) (princ) ) (defun print-align-text ( owner reactor lst / sp ep a d ) (setq sp (vlax-curve-getstartpoint owner)) (setq ep (vlax-curve-getendpoint owner)) (setq a (angle sp ep)) (setq d (distance sp ep)) (vla-put-textstring (cdr (assoc owner mylines+mytexts)) (rtos d 2 ) (vla-put-height (cdr (assoc owner mylines+mytexts)) (/ d 25.0)) (vla-put-alignment (cdr (assoc owner mylines+mytexts)) acalignmentmiddlecenter) (vla-put-textalignmentpoint (cdr (assoc owner mylines+mytexts)) (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0)))) (vla-put-rotation (cdr (assoc owner mylines+mytexts)) a) ) (defun c:mylines ( / myline mytext str loop sp ep a d ) (vl-load-com) (setq loop T) (while loop (setq sp (getpoint "\nPick start point : ")) (setq ep (getpoint sp "\nPick end point : ")) (setq myline (vla-addline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point sp) (vlax-3d-point ep) ) ) (setq a (angle sp ep)) (setq d (distance sp ep)) (setq mytext (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (rtos d 2 (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0))) (/ d 25.0) ) ) (vla-put-alignment mytext acalignmentmiddlecenter) (vla-put-textalignmentpoint mytext (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0)))) (vla-put-rotation mytext a) (setq mylines+mytexts (cons (cons myline mytext) mylines+mytexts)) (if (not (eq (setq str (getstring "\nENTER to continue making lines; any key+ENTER to finish : ")) "")) (setq loop nil)) ) (alert "\nType [Command: objreac] to activate object reactor for line entities") (princ) ) M.R. Quote
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.