Jump to content

LISP for Room Size 2 horizontal points & 2 vertical points


nihar

Recommended Posts

Hi,

i want a LISP for Room Size (picking 2 horizontal points) & y-distance (picking 2 vertical points) to be placed as text format.

Output e.g: 5000MM X 5000MM.

 

Please help.

 

Thanks,

Link to comment
Share on other sites

A quick code as an example for you. Because i use command "rectang" so it'd have fix in the future

(defun c:test(/ ptt1 ptt2 ptt3  ss )
(vl-load-com)
(grtext -1 "Free lisp from Cadviet @Ketxu (S\U+01A1n T\U+00F9ng)! ")
(defun wtxt_l(txt p h)
(entmake (list (cons 0 "TEXT") (cons 7 (getvar "textstyle")) (cons 40 h)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
               p2 (vlax-safearray->list p2)
               pt (mapcar '+ p1 p2)
               pt (mapcar '* pt '(0.5 0.5 0.5))
   )
   pt
)

(setvar "cmdecho" 0)
(command "undo" "begin") 
(if (not h) (setq h 180))
(setq scl (getvar "dimlfac")
   caot1 (getreal (strcat "\nText Height : < " (rtos h 2 2) " >: "))
   ss (ssadd) tLay (getvar "clayer"))
(if caot1 (setq h caot1))
(setvar "dimzin" 0) 
(if (setq ptt1 (getpoint "\nPick point 1:"))(setq ptt2 (getpoint ptt1 "\nPick point 2:")))
(if  ptt2 (setq ptt3 (getpoint ptt2 "\nPick point 3:")))
(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil))
   (command ".ucs" ptt1 ptt2 "" ".rectang"  (trans ptt1 0 1) (trans ptt3 0 1) ".ucs" "")
   (setq elast (entlast));; boundary    
   (ssadd elast ss)
   (wtxt_l (strcat (rtos (* (distance ptt1 ptt2) scl) 2 0) "mm x " (rtos (* (distance ptt2 ptt3) scl) 2 0) "mm") (mid elast) h) 
   (if (setq ptt1 (getpoint "\nPick point 1:"))(setq ptt2 (getpoint ptt1 "\nPick point 2:")))
   (if  ptt2 (setq ptt3 (getpoint ptt2 "\nPick point 3:")))
);while
(setq ans (getstring " Clear bound ? [Y/N ] :?"))    
(if (or (= ans "")(= ans nil)(= (strcase ans) "Y")) (command "erase" ss ""))
(command "undo" "end")
(setvar "cmdecho" 1)
)

Link to comment
Share on other sites

Hi,

i want a LISP for Room Size (picking 2 horizontal points) & y-distance (picking 2 vertical points) to be placed as text format.

 

This is a strange one :)

 

Why four points and not 2 corners?

 

4 points

 
(defun c:test1  (/ 4Points LxW)
     (vl-load-com)
     (foreach
            prmpt
                 '("1st Vertical:"
                   "2nd Vertical:"
                   "1st Horizontal:"
                   "2nd Horizontal:")
           (setq 4Points
                      (cons (getpoint (strcat "\n" prmpt))
                            4Points)))
     (setq 4Points (reverse 4Points)
           LxW     (list (distance (caddr 4Points) (last 4Points))
                         (distance (car 4Points) (cadr 4Points)))
           ) 
     (vlax-invoke
           (vlax-get
                 (vla-get-ActiveLayout
                       (vla-get-activedocument
                             (vlax-get-acad-object)))
                 'Block)
           'AddmText
           (getpoint "\nPick point for text:")
           0.0
           (strcat (rtos (car LxW) 2 0)
                   "MM X "
                   (rtos (cadr LxW) 2 0)
                   "MM")
           )
     )

 

2 corners (lower left/upper right)

 
(defun c:test2 (/ pt1 pt2 pt3 LxW)
     (vl-load-com)
     (setq pt1 (getpoint "\nLower Left Corner:")
           pt3 (getcorner pt1 "\nLower Upper Rigbt  Corner:"))
     (setq pt2 (list (car pt1) (cadr pt3) 0.0))
     (setq LxW (list (distance pt1 pt2) (distance pt2 pt3)))
     (vlax-invoke
           (vlax-get
                 (vla-get-ActiveLayout
                       (vla-get-activedocument
                             (vlax-get-acad-object)))
                 'Block)
           'AddmText
           (getpoint "\nPick point for text:")
           0.0
           (strcat (rtos (car LxW) 2 0)
                   "MM X "
                   (rtos (cadr LxW) 2 0)
                   "MM")
           )
     )

Link to comment
Share on other sites

Another suggestion 3 points if room rotated but still a square room, alternative would be 2 points but first point picks a line and changes the angle to get square answer.

Link to comment
Share on other sites

Another suggestion 3 points if room rotated but still a square room, alternative would be 2 points but first point picks a line and changes the angle to get square answer.

 

Godo idea Bigal :)

Link to comment
Share on other sites

(defun c:RM (/ roomname roomsz) 
  (defun roomname ()
  (textpage)
  (princ "\nROOMNAME OPTIONS: ")
  (princ "\n\t Living   Kitchen    Bed     Toilet ")  
  (princ "\n\t Office   SHop       STore   STUdy  ")
  (princ "\n\t Dining   Puja       BAth    W.c. = WC  ")
  (princ "\n\t LIft = LT    LObby      S.toi.  Living/dining = LD ")
  (princ "\n\nPress any key to return to your drawing ")
  (grread)
  (princ "\r                                          ")
  (graphscr)
  )       ;End of roomname

  (defun roomsz (/ p1 p2 p3 p4 x x1 y y1 tx h ht1 rm op pl pm tm ft rsz pll)
  (sharad) 
  (if (null txlay) 
   (progn
      (setq txlay "tx")
      (setq txlayer (tblsearch "layer" txlay))
    (if (null txlayer)
        (progn
          (setq txlay (getstring "\nLayer name for TEXT : "))
          (setq txclr (getstring (strcat "\nColor for " txlay " layer: ")))
          (command "layer" "m" txlay "c" txclr "" "")
        ) 
      (prompt "\nTEXT ON TX LAYER")
    )
   )
  ) 
  (setvar "osmode" 32)
  (menucmd "p0=filters") (menucmd "p0=*") 
  (if (null ht) (setq ht "250"))
  (setq p1 (getpoint "\nPick room corner: ")
        p2 (getcorner p1 "\nPick Diagonally opposite corner: ")
        p3 (list (car p2)(cadr p1)) p4 (list (car p1)(cadr p2))
        a  (distance p1 p3) b (distance p1 p4)
        x  (* 0.001 a) y (* 0.001 b) x1 (rtos x 2 2) y1 (rtos y 2 2)
        mt (strcat x1 "x" y1))
  (setq ix (cvunit x "meter" "inch") iy (cvunit y "meter" "inch")
        xf (rtos ix 4 0) yf (rtos iy 4 0) ft (strcat xf "x" yf))
  (PROMPT "\nENTER FOLLOWING KEYWORD OR TY FOR TYPE") 
  (setq cnt T)
  (while cnt
   (initget 1 (strcat "Living Kitchen Bed Toilet "  
                     "Office SHop STore STUdy "
                     "Dining Puja BAth WC TY ? "
                     "LT LObby S.toi. LD "))
  (setq rm (getkword 
     "\nROOM NAME = Liv/Bed/Kit/Toi/Off/Din/SHop/BAth/WC/STore/STUdy/S./LT/LD/LO/TYpe/?:"))
  (if (/= (type rm) 'LIST)
    (if (= rm "?") 
       (progn
          (roomname) (setq cnt T)
       )
        (progn  
          (setq cnt nil)
          (if (= rm "LT") (setq rm "LIFT"))
          (if (= rm "LD") (setq rm "living/dining"))
          (if (= rm "WC")  (setq rm "W.C."))
           (IF (= rm "TY") (setq rsz (strcase
                               (getstring t"\nTYPE ROOM NAME: ")))
              (setq rsz (strcase rm))
             )
        )
    ) (setq cnt nil)
   )
  )
  (setq tm (strcase (getstring (strcat "\nENTER TEXT HEIGHT <" ht ">:")) t))
  (if (/= tm "")(setq ht tm))
  (setq h (atof ht) ht1 (* h 0.88888) dt (* h 1.7))
  (setvar "osmode" 0) 
  (setvar "orthomode" 1) 
  (setq ht1 (fix ht1))
  (setq pc (polar p1 (angle p1 p2) (/ (distance p1 p2) 2))
        pm (polar pc (* pi 1.5) (/ h 3.55))
        pt (polar pc (/ pi 2) dt) pf (polar pc (* pi 1.5) dt))
  (command "layer" "t" txlay "on" txlay "s" txlay ""
           "text" "s" "rD" "m" pt h "0" rsz)
  (setq pm2 (getpoint pm "\nENDPOINT OF TEXT: ")
       PM1 (polar pm pi (distance pm pm2)) 
       pf1 (polar pf pi (distance pm pm2))
       pf2 (polar pf 0  (distance pm pm2)))  
  (command "text" "s" "rs" "f" pm1 pm2 ht1 mt 
           "text" "f" pf1 pf2 ht1 ft )       
)) 

Link to comment
Share on other sites

Good one autolisp just a suggestion to save typing you can pop screen menus on the sides these can hold the room names so you pick room name then they disappear another method would be to do a dialouge list to pick from. I use a autoloaded listselect.lsp that was gratefully supplied by AlanJT. And I now use it on multiple programs but you only need it once. As its AlanJT's code it appropriate for him to share.

Link to comment
Share on other sites

Good one autolisp just a suggestion to save typing you can pop screen menus on the sides these can hold the room names so you pick room name then they disappear another method would be to do a dialouge list to pick from. I use a autoloaded listselect.lsp that was gratefully supplied by AlanJT. And I now use it on multiple programs but you only need it once. As its AlanJT's code it appropriate for him to share.

Dear Sir

thx for appreciation

i try to single pick point, but not done can u help me

dear sir,

share some video single pick plz chk

http://www.4shared.com/folder/zw1nWToC/_online.html

Edited by autolisp
add link
Link to comment
Share on other sites

Just use entsel then you can get start, end pts and angle etc the rest is easy simple maths

 

(setq tp1 (entsel "\nSelect left side outer wall near end : "))
 (setq tpp1 (entget (car tp1)))
 (setq pt1 (cdr (assoc 10 tpp1)))      
 (setq pt2 (cdr (assoc 11 tpp1)))      
 (setq pt3 (cadr tp1))

Link to comment
Share on other sites

Just use entsel then you can get start, end pts and angle etc the rest is easy simple maths

 

(setq tp1 (entsel "\nSelect left side outer wall near end : "))
 (setq tpp1 (entget (car tp1)))
 (setq pt1 (cdr (assoc 10 tpp1)))      
 (setq pt2 (cdr (assoc 11 tpp1)))      
 (setq pt3 (cadr tp1))

dear sir,

thx for reply i will try but not done

Link to comment
Share on other sites

  • 1 year later...

If you look carefully at the code examples you will see that they use some form of distance routine, then convert the answer to a string for text its easy to spot by the "mm" for feet answers you will need to make sure your "units" are set correct and modify some of the code as a first step make sure your drawing is set to feet what are the answers you are getting ?

 

Why not have a go good time to learn, help is here.

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.

×
×
  • Create New...