nihar Posted July 22, 2011 Share Posted July 22, 2011 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, Quote Link to comment Share on other sites More sharing options...
ketxu Posted July 22, 2011 Share Posted July 22, 2011 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) ) Quote Link to comment Share on other sites More sharing options...
pBe Posted July 22, 2011 Share Posted July 22, 2011 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") ) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 25, 2011 Share Posted July 25, 2011 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. Quote Link to comment Share on other sites More sharing options...
pBe Posted July 25, 2011 Share Posted July 25, 2011 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 Quote Link to comment Share on other sites More sharing options...
autolisp Posted July 25, 2011 Share Posted July 25, 2011 (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 ) )) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 26, 2011 Share Posted July 26, 2011 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. Quote Link to comment Share on other sites More sharing options...
autolisp Posted July 26, 2011 Share Posted July 26, 2011 (edited) 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 July 26, 2011 by autolisp add link Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 26, 2011 Share Posted July 26, 2011 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)) Quote Link to comment Share on other sites More sharing options...
autolisp Posted July 26, 2011 Share Posted July 26, 2011 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 Quote Link to comment Share on other sites More sharing options...
habitatdezine Posted January 1, 2013 Share Posted January 1, 2013 thanks for the lovely routine , can this be done with output in feet and inches ? Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 2, 2013 Share Posted January 2, 2013 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. 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.