See the top rated post in this thread. Click here

Page 1 of 2 12 LastLast
Results 1 to 10 of 12

Thread: Need help editing LISP routine to rotate attributes to readable angle

  1. #1
    Member
    Join Date
    2016-09
    Posts
    8
    Login to Give a bone
    0

    Default Need help editing LISP routine to rotate attributes to readable angle

    Hi Friends,
    i have lisp, which rotates the attributes as per the block angle...but there is an issue on that....
    as per the attached screenshot, for some block angles, attributes are not in readable angle...
    could someone help me to edit the lisp, so as to get attributes aligned in readable angles.

    attached sample drawing & screenshots.

    HTML Code:
    (vl-load-com)
    (defun c:test ( / oldang oldunit oldsnap obj ang ins Tp xscale bname ins)
    (setq oldang (getvar 'angdir))
    (setq oldunit (getvar 'aunits))
    (setq oldsnap (getvar 'osmode))
    (setvar 'angdir 0)
    (setvar 'aunits 3)
    (setvar 'osmode 0)
    
    (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
    (setq Objname (vla-get-Objectname obj))
    (if (/= Objname "AcDbBlockReference") ; check is it a block
    (alert "You have not Picked a block\n\nPress ok ")
    (progn
    (setq ang (vla-get-rotation obj))
    (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint 
    
    obj))))
    (setq xscale (vla-get-XScaleFactor obj))
    (setq bname (vla-get-name obj))
    
    (cond
    ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
    ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
    )
    (setq off 6.0)
    (setq off1 8.0)
    
    (setq Tp  (vlax-ename->vla-object (car  (entsel "\nPick text1"))))
    (setq pt1 (vlax-3d-point  (polar ins (+ ang (/ 0.25)) off1)))
    (vla-put-insertionpoint Tp  pt1)
    (vla-put-rotation Tp ang )
    
    (setq Tp  (vlax-ename->vla-object (car  (entsel "\nPick text2"))))
    (setq pt1 (vlax-3d-point  (polar ins (+ ang (/ 0.2)) off1)))
    (vla-put-insertionpoint Tp  pt1)
    (vla-put-rotation Tp ang )
    
    (setq Tp  (vlax-ename->vla-object (car  (entsel "\nPick text3"))))
    (setq pt1 (vlax-3d-point  (polar ins ang (* len 1.7))))
    (vla-put-insertionpoint Tp  pt1)
    (vla-put-rotation Tp ang )
    
    (setvar 'angdir oldang)
    (setvar 'aunits oldunit)
    (setvar 'osmode oldsnap)
    )
    )
    )

    Thanks in Advance.
    Last edited by malikbasha1308735440; 2020-08-14 at 10:33 PM.

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,471
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  3. #3
    Member
    Join Date
    2016-09
    Posts
    8
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    Quote Originally Posted by Tom Beauford View Post


    Hi Tom Beauford,

    the links are same, which i posted earlier & that issue got resolved already...
    do you want me to continue the query on that earlier post itself ....could you please explain

  4. #4
    Active Member
    Join Date
    2015-12
    Location
    Western Europe
    Posts
    57
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    I still cannot open your drawing

    This adjustment to your lisp should work. Once each text is rotated it is passed to the (rh:rta) sub-routine. This tests if the rotation is between 90 and 270. If it is, it finds the midpoint of the text bounding box and rotates it 180 degrees. This should work for "TEXT" items only. If you are using "MTEXT" it will need expanding as the bounding box of "MTEXT" is based on the width property not the objects extents.

    HTML Code:
    (defun rh:rta (obj / a ll ur lst cpt)
      (setq a (vlax-get obj 'rotation))
      (cond ( (< (* pi 0.5) a (* pi 1.5))
              (vlax-invoke-method obj 'getboundingbox 'll 'ur)
              (setq lst (mapcar 'vlax-safearray->list (list ll ur))
                    cpt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst))
              )
              (vlax-invoke obj 'rotate cpt pi)
            )
      );end_cond
    );end_defun
    
    
    (vl-load-com)
    
    (defun c:test ( / oldang oldunit oldsnap obj ang ins Tp xscale bname ins)
      (setq oldang (getvar 'angdir))
      (setq oldunit (getvar 'aunits))
      (setq oldsnap (getvar 'osmode))
      (setvar 'angdir 0)
      (setvar 'aunits 3)
      (setvar 'osmode 0)
    
      (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
      (setq Objname (vla-get-Objectname obj))
      (if (/= Objname "AcDbBlockReference") ; check is it a block
        (alert "You have not Picked a block\n\nPress ok ")
        (progn
          (setq ang (vla-get-rotation obj))
          (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
          (setq xscale (vla-get-XScaleFactor obj))
          (setq bname (vla-get-name obj))
    
          (cond
          ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
          ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
          )
          (setq off 6.0)
          (setq off1 8.0)
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text1"))))
          (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.25)) off1)))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (rh:rta Tp)
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text2"))))
          (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.2)) off1)))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (rh:rta Tp)
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text3"))))
          (setq pt1 (vlax-3d-point (polar ins ang (* len 1.7))))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (rh:rta Tp)
    
          (setvar 'angdir oldang)
          (setvar 'aunits oldunit)
          (setvar 'osmode oldsnap)
        )
      )
    )

  5. #5
    Member
    Join Date
    2016-09
    Posts
    8
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    Hi dlanor,
    Thank you so much for looking on my post & sorry for uploading again a latest version dwg, now i have converted to older version & uploaded,
    Thank you so much for your code, it almost worked .... its now going in proper readable angle but the arrangements are getting upside down,
    i have attached the screenshot, which shows the issues.
    could you please look on to it.

    Thanks in Advance.
    Last edited by malikbasha1308735440; 2020-08-14 at 10:27 PM.

  6. #6
    Active Member
    Join Date
    2015-12
    Location
    Western Europe
    Posts
    57
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    OK, drawing opens and I can see whats what. Should have something in a couple of hours.

  7. #7
    Active Member
    Join Date
    2015-12
    Location
    Western Europe
    Posts
    57
    Login to Give a bone
    1

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    OK try this modified version

    HTML Code:
    ;; based on ssboundingbox by Lee Mac
    ;; boundingbox of a lst of objects
    (defun bblst ( lst / ll ur lllst urlst)
      (foreach obj lst
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
            )
          (setq lllst (cons (vlax-safearray->list ll) lllst) urlst (cons (vlax-safearray->list ur) urlst))
        )
      )
      (if (and lllst urlst) (mapcar '(lambda ( x y ) (apply 'mapcar (cons x y))) '(min max) (list lllst urlst)))
    )
    
    (defun rh:rta (lst a / rlst cpt)
      (cond ( (< (* pi 0.5) a (* pi 1.5))
              (vlax-invoke-method obj 'getboundingbox 'll 'ur)
              (setq rlst (rh:bblst lst)
                    cpt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car rlst) (cadr rlst))
              )
              (foreach o lst (vlax-invoke o 'rotate cpt pi))
            )
      );end_cond
    );end_defun
    
    
    (vl-load-com)
    
    (defun c:test ( / oldang oldunit oldsnap obj ang ins olst Tp xscale bname ins)
      (setq oldang (getvar 'angdir))
      (setq oldunit (getvar 'aunits))
      (setq oldsnap (getvar 'osmode))
      (setvar 'angdir 0)
      (setvar 'aunits 3)
      (setvar 'osmode 0)
    
      (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
      (setq Objname (vla-get-Objectname obj))
      (if (/= Objname "AcDbBlockReference") ; check is it a block
        (alert "You have not Picked a block\n\nPress ok ")
        (progn
          (setq ang (vla-get-rotation obj))
          (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
          (setq xscale (vla-get-XScaleFactor obj))
          (setq bname (vla-get-name obj))
    
          (cond
          ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
          ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
          )
          (setq off 6.0)
          (setq off1 8.0)
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text1"))))
          (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.25)) off1)))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (setq olst (cons tp olst))
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text2"))))
          (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.2)) off1)))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (setq olst (cons tp olst))
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text3"))))
          (setq pt1 (vlax-3d-point (polar ins ang (* len 1.7))))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (setq olst (cons tp olst))
    
          (rh:rta olst ang)
    
          (setvar 'angdir oldang)
          (setvar 'aunits oldunit)
          (setvar 'osmode oldsnap)
        )
      )
    )

  8. #8
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    8,620
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    Is that making the text plan readable?
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  9. #9
    Member
    Join Date
    2016-09
    Posts
    8
    Login to Give a bone
    0

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    Hi dlanor,
    i have loaded your updated lisp & run the command "test" , but still its the same ...its not going to readable able....shown the same in screenshot
    Thanks for looking on it
    Last edited by malikbasha1308735440; 2020-08-14 at 10:35 PM.

  10. #10
    Active Member
    Join Date
    2015-12
    Location
    Western Europe
    Posts
    57
    Login to Give a bone
    1

    Default Re: Need help editing LISP routine to rotate attributes to readable angle

    Apologies, I changed a sub-routine name, but forgot to rename the line calling it.

    HTML Code:
    ;; based on ssboundingbox by Lee Mac
    ;; boundingbox of a lst of objects
    (defun bblst ( lst / ll ur lllst urlst)
      (foreach obj lst
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
            )
          (setq lllst (cons (vlax-safearray->list ll) lllst) urlst (cons (vlax-safearray->list ur) urlst))
        )
      )
      (if (and lllst urlst) (mapcar '(lambda ( x y ) (apply 'mapcar (cons x y))) '(min max) (list lllst urlst)))
    )
    
    (defun rh:rta (lst a / rlst cpt)
      (cond ( (< (* pi 0.5) a (* pi 1.5))
              (vlax-invoke-method obj 'getboundingbox 'll 'ur)
              (setq rlst (bblst lst)
                    cpt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car rlst) (cadr rlst))
              )
              (foreach o lst (vlax-invoke o 'rotate cpt pi))
            )
      );end_cond
    );end_defun
    
    
    (vl-load-com)
    
    (defun c:test ( / oldang oldunit oldsnap obj ang ins olst Tp xscale bname ins)
      (setq oldang (getvar 'angdir))
      (setq oldunit (getvar 'aunits))
      (setq oldsnap (getvar 'osmode))
      (setvar 'angdir 0)
      (setvar 'aunits 3)
      (setvar 'osmode 0)
    
      (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
      (setq Objname (vla-get-Objectname obj))
      (if (/= Objname "AcDbBlockReference") ; check is it a block
        (alert "You have not Picked a block\n\nPress ok ")
        (progn
          (setq ang (vla-get-rotation obj))
          (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
          (setq xscale (vla-get-XScaleFactor obj))
          (setq bname (vla-get-name obj))
    
          (cond
          ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
          ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
          )
          (setq off 6.0)
          (setq off1 8.0)
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text1"))))
          (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.25)) off1)))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (setq olst (cons tp olst))
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text2"))))
          (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.2)) off1)))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (setq olst (cons tp olst))
    
          (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text3"))))
          (setq pt1 (vlax-3d-point (polar ins ang (* len 1.7))))
          (vla-put-insertionpoint Tp pt1)
          (vla-put-rotation Tp ang )
          (setq olst (cons tp olst))
    
          (rh:rta olst ang)
    
          (setvar 'angdir oldang)
          (setvar 'aunits oldunit)
          (setvar 'osmode oldsnap)
        )
      )
    )

    Select the texts in the order you want them to appear (top to bottom) Each text will be spaced then all texts rotated.

Page 1 of 2 12 LastLast

Similar Threads

  1. Replies: 3
    Last Post: 2017-11-17, 06:06 PM
  2. Need Help: LISP Changing Routine Angle
    By loudy000 in forum AutoLISP
    Replies: 10
    Last Post: 2016-10-24, 06:21 PM
  3. Help editing AutoLisp routine-autonumbering by attributes
    By niccolel363615 in forum AutoLISP
    Replies: 2
    Last Post: 2014-09-16, 07:40 PM
  4. LISP Routine for editing specific attributes
    By rseybert434569 in forum AutoLISP
    Replies: 2
    Last Post: 2013-10-26, 03:41 PM
  5. NEED HELP WITH LISP ROUTINE - PURGE linetype lisp
    By ECASAOL350033 in forum AutoLISP
    Replies: 6
    Last Post: 2013-06-21, 01:13 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •