Leaderboard

Here's my take on it: (defun c:foo (/ lm:unformat b el p r s sp tx) (cond ((setq s (ssget ":L" '((0 . "CIRCLE")))) (cond ((null (tblobjname "block" "Bubble")) (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "Bubble") (10 0. 0. 0.) (70 . 2) ) ) (entmake '((0 . "CIRCLE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbCircle") (10 0. 0. 0.) (40 . 1.) ) ) (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbText") (10 0. 0. 0.) (40 . 0.75) (1 . "") (50 . 0) (41 . 1) (51 . 0) (7 . "Standard") (71 . 0) (72 . 1) (11 0. 0. 0.) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "") (2 . "#") (70 . 8) (73 . 0) (74 . 2) (280 . 1) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))) ) (command "_.ATTSYNC" "_NAME" "BUBBLE") ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun lm:unformat (str mtx / _replace rx) (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda () (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '(("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]" ) ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str) ) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0)))))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq r (/ (cdr (assoc 40 (setq el (entget e)))) 2.)) (setq p (cdr (assoc 10 el))) (cond ((setq tx (ssget "_C" (mapcar '- p (list r r r)) (mapcar '+ p (list r r r)) '((0 . "*TEXT"))) ) (setq r (* 2 r)) (setq b (vla-insertblock sp (vlax-3d-point p) "Bubble" r r r 0.)) (vla-put-textstring (car (vlax-invoke b 'getattributes)) (lm:unformat (cdr (assoc 1 (entget (ssname tx 0)))) nil) ) (entmod (append (entget (vlax-vla-object->ename b)) '((8 . "BUBBLE")))) (entdel e) (entdel (ssname tx 0)) ) ) ) ) ) (princ) )

Try the code again, I implemented Lee's unformat function.

Or you can change it in the code (if (not (setq d (getreal "\nType the search radius for the text <2.0>: "))) (setq d 2.) ) for: (if (not (setq d (getreal "\nType the search radius for the text <4.0>: "))) (setq d 4.) )

That's why it asks for a radius, you can change it to 3, 4 or any you want so it can search for a longer distance

Here is mine, with some help of Ronjonp's code.

This should work, load it into CAD, command is txt2circ (or txt2rect, txt2cent).. single texts at a time, not the latest request Txt2Circ.lsp

I have updated the code in the original post.

The first video shows the option to run the code on all affected circles and texts, without asking the user. The second video shows the option to have the user confirm (by pressing 'Y', ENTER or 'K' to skip), circle by circle, whether the text to be moved is correct. This option may be useful in some cases. Anyway, I have changed the code to override the "OSMODE" variable during execution, just in case.

I just ran the code on your drawing and it works fine. Nikon1.mp4 Nikon2.mp4

It seems to me that your code is a bit complicated, there is probably an easier way, like the Lee Mac program Text 2 Point. ;; Text 2 Point - Lee Mac 2012 It seems that you have the text moved to where you want, just have to use the properties panel to change the alignment to midcenter.

hi steven, the expected problem solved to me @pkenewell solved the issue with a small command code. Thanks for the support, Steven. "In your code, though, you only set OSMODE to 0 in line 343, I don't think you need that and it can be commented out... and you comment out the problem (put a ; at the start of the line)." yes you are right, i checked this line 343 osmode 0, that also will do same your instruction thank you regards, rahil

This is a bit longer than it needs to be, should align text to a circle and 'MC' the text, works with MText, Text and Attributes Command txt2circ Also include txt2rect (centres text between 2 points) txt2cent (centres text in centroid of closed polygon, also circles) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun rectcentre ( / pt1 pt2 ptx pty ptz ptc) ; Returns centre of a rectangle (2 points) (setq pt1 (getpoint "\nPick Corner 1")) (setq pt2 (getpoint "\nPick Corner 2")) (setq ptx (+ (nth 0 pt1) (/ (- (nth 0 pt2)(nth 0 pt1)) 2)) ) ;; do these 3 lines with mapcar (setq pty (+ (nth 1 pt1) (/ (- (nth 1 pt2)(nth 1 pt1)) 2)) ) (setq ptz (+ (nth 2 pt1) (/ (- (nth 2 pt2)(nth 2 pt1)) 2)) ) (setq ptc (list ptx pty ptz)) ptc ) (defun circcentre ( / circ ent ptc enttype) ; returns centre of a circle (princ "\nSelect Circle") (while (/= enttype "CIRCLE") (setq circ (car (entsel ""))) (setq ent (entget circ)) (setq enttype (cdr (assoc 0 ent))) ) (setq ptc (assoc 10 ent)) (setq ptc (list (nth 1 ptc)(nth 2 ptc)(nth 3 ptc))) ptc ) (defun cent (/ obj rgn pt) ;;https://www.cadtutor.net/forum/topic/71044-center-of-polygon/ (if (and (setq obj (car (entsel "\nSelect object to calculate centroid: "))) (setq spc (vlax-ename->vla-object (cdr (assoc 330 (entget obj))))) (setq obj (vlax-ename->vla-object obj)) (= 'list (type (setq rgn (vl-catch-all-apply 'vlax-invoke (list spc 'addregion (list obj)))))) ) (progn (setq pt (vlax-get (setq rgn (car rgn)) 'centroid)) (vl-catch-all-apply 'vla-delete (list rgn)) ) ) pt ) (defun c:txt2rect ( / ptc centretext) ; Place text between 2 points (setq ptc (rectcentre)) (txt2centre ptc) ) (defun c:txt2circ ( / ptc) ; place text in centre of circle (setq ptc (circcentre)) (txt2centre ptc) ) (defun c:txt2cent ( / ptc) ; place text in middle of centroid (setq ptc (cent)) (txt2centre ptc) ) (defun txt2centre ( ptc / txtset alignment myrotation Edata ptx pty mycons NewInsData NewData entlist entwidth newwidth elist sel endloop enttype txt) ;;;;;;;; Sub routines ;;;;;;;;; ;; From Box Text LISP ;; Text Box - gile / Lee Mac ;; Returns an OCS point list describing a rectangular frame surrounding ;; the supplied text or mtext entity with optional offset ;; enx - [lst] Text or MText DXF data list ;; off - [rea] offset (may be zero) (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid ) (cond ( (= "TEXT" (cdr (assoc 00 enx))) (setq bpt (cdr (assoc 10 enx)) rot (cdr (assoc 50 enx)) lst (textbox enx) lst (list (list (- (caar lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar lst) off) (+ (cadadr lst) off)) ) ) ) ( (= "MTEXT" (cdr (assoc 00 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 10 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs)) wid (cdr (assoc 42 enx)) hgt (cdr (assoc 43 enx)) jus (cdr (assoc 71 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list (list (- (car org) off) (- (cadr org) off)) (list (+ (car org) wid off) (- (cadr org) off)) (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off) (+ (cadr org) hgt off)) ) ) ) ) (if lst ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) ; end textboxoff (defun gettextalign ( txtset / txtset Edata ptx_old pty_old pty_new ptx_new mycons) (setq Edata (entget (ssname txtset 0))) (setq mycons 10) (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11)) (setq ptx_old (nth 1 (assoc mycons Edata))) (setq pty_old (nth 2 (assoc mycons Edata))) (command "_.justifytext" txtset "" "MC") (setq Edata (entget (ssname txtset 0))) (setq ptx_new (nth 1 (assoc mycons Edata))) (setq pty_new (nth 2 (assoc mycons Edata))) (if (< ptx_old ptx_new)(setq alignx "L")) (if (> ptx_old ptx_new)(setq alignx "R")) (if (= ptx_old ptx_new)(setq alignx "C")) (if (> pty_old pty_new)(setq aligny "T")) (if (< pty_old pty_new)(setq aligny "B")) (if (= pty_old pty_new)(setq aligny "M")) (setq xyalign (strcat aligny alignx)) (command "_.justifytext" txtset "" xyalign) ;; remove this line to leave MC aligned xyalign ) ;;;;;;;;;; End sub routines ;;;;;;;;;;; (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark thisdrawing) (princ "\nSelect Text") (while (and (/= enttype "TEXT")(/= enttype "MTEXT")(/= enttype "ATTDEF")) (setq txt (car (entsel ""))) (setq Edata (entget txt)) (setq enttype (cdr (assoc 0 Edata))) ) (setq txtset (ssadd)) (setq txtset (ssadd txt txtset)) (setq myrotation (cdr (assoc 50 Edata))) (setq Newdata (subst (cons 50 0) (assoc 50 Edata) Edata) ) (entmod Newdata) (setq alignment (gettextalign txtset)) (setq ptx (nth 0 (assoc 10 Edata))) (setq pty (nth 1 (assoc 10 Edata))) (command "_.justifytext" txtset "" "MC") (setq Edata (entget (ssname txtset 0))) (setq mycons 10) (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11)) (setq NewInsData (cons mycons ptc) ) (setq Newdata (subst NewInsdata (assoc mycons Edata) Edata) ) (if (= "TEXT" (cdr (assoc 0 Edata))) (progn (setq Newdata (subst (cons 50 myrotation)(assoc 50 Newdata) Newdata)) (entmod Newdata) ) ) (if (= "ATTDEF" (cdr (assoc 0 Edata))) (progn (entmod Newdata) ) ) (if (= "MTEXT" (cdr (assoc 0 Edata))) ;;mtext etc. (progn (setq entlist Edata) ;;could be Edata (setq entwidth entlist) (setq newwidth (cdr (assoc 42 entlist))) ;;text line width assoc 41 for mtext 'box' width (if (< newwidth (cdr (assoc 42 entwidth)))(setq newwidth (+ MWidth newwidth))) (if (= (cdr (assoc 41 entlist)) 0)(setq newwidth 0)) ;;fix for zero width mtexts (setq elist (subst (cons 41 newwidth)(assoc 41 Edata) Edata)) ;;if txt this is width factor, mtext its text width (setq elist (subst (cons mycons ptc)(assoc mycons elist) elist)) (setq elist (subst (cons 50 myrotation)(assoc 50 elist) elist)) (entmod elist) ) ) (setq alignment "MC") (command "_.justifytext" txtset "" alignment) (vla-endundomark thisdrawing) (princ) )

In any case, there are some things you should improve in your code. For example, replacing the calls to 'command' with other, more efficient methods. It is better for you to learn to do these small improvements yourself, little by little.

Are you sure it doesn't work? Maybe I don't understand you well. Anyway, copy the code again and try it: I changed something

@rahil40 OK - find the function "RMD2_SET" (or "RMD_SET" in the V6 version) in the lsp file and make the following change. Try it and let us know if that did the trick: (defun RMD2_SET (ERRORMSG) ;(command nil nil nil) ; <--- Comment this out by leading it with a semi-colon (command-s)(command-s) ; <--- Add this line (if (not (member ERRORMSG '("console break" "Function cancelled"))) (princ (strcat "\nError:" ERRORMSG))) (if SUS (mapcar 'setvar SUS_LIST SUS)) (princ "\nAttention!....A user error has occurred.") (princ "\nThe program will now restore the user settings and exit.") (terpri) (setq *error* TERR$) (princ)) (EDIT: Tested and corrected earlier replacement)

A variation of the original (defun c:AlignTxtToCircleAllDrawing (/ n conj conj1 ent ent1 lstent pto rad pt1 pt2 x pto selEnt distMin AlignTxtToCircle 1x1? osmant) (defun AlignTxtToCircle (circle textObj / mtextObj centerPoint textHeight circles texts opt centroTexto ) (defun centroTexto (lstent / cajatx difx dify SO SE NE NO ptC) (if (= (cdr (assoc 0 lstent)) "MTEXT") (setq NO (cdr (assoc 10 lstent)) ptC (list (+ (car NO) (/ (cdr (assoc 41 lstent)) 2.0)) (- (cadr NO) (/ (cdr (assoc 40 lstent)) 2.0)) ) ) (setq cajatx (textbox lstent) difx (- (car (cadr cajatx)) (car (car cajatx))) dify (- (cadr (cadr cajatx)) (cadr (car cajatx))) SO (polar (cdr (assoc 10 lstent)) (- (cdr (assoc 50 lstent)) (/ pi 2)) (abs (cadr (car cajatx))) ) NE (polar (polar so (cdr (assoc 50 lstent)) difx) (+ (cdr (assoc 50 lstent)) (/ pi 2)) dify) ptC (polar SO (angle SO NE) (/ (distance SO NE) 2.0)) ) ) ptC ) (defun obj->txMC (ent / lstent tipObj vlaEnt texto estilo capa ang ptins altura) (cond ((= (setq tipObj (cdr (assoc 0 (setq lstent (entget ent))))) "TEXT" ) (vlax-put-property (vlax-ename->vla-object ent) "Alignment" 10 ) (vlax-put-property (vlax-ename->vla-object ent) "TextAlignmentPoint" (VLAX-3D-POINT (cdr (assoc 10 lstent))) ) ent ) ((= tipObj "MTEXT") (setq texto (if (setq pos (vl-string-search ";" (cdr (assoc 1 lstent))) ) (if (setq pos (vl-string-search "}" (setq texto (substr (cdr (assoc 1 lstent)) (+ pos 2) ) ) ) ) (substr texto 1 pos) texto ) (cdr (assoc 1 lstent)) ) estilo (cdr (assoc 7 lstent)) capa (cdr (assoc 8 lstent)) ang (cdr (assoc 50 lstent)) ptins (cdr (assoc 10 lstent)) altura (cdr (assoc 40 lstent)) vlaEnt (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object) ) ) texto (VLAX-3D-POINT ptins) altura ) ) (vlax-put vlaEnt "ROTATION" ang) (vlax-put vlaEnt "LAYER" capa) (vlax-put vlaEnt "STYLENAME" estilo) (vlax-put-property vlaEnt "Alignment" 10) (vlax-put-property vlaEnt "TextAlignmentPoint" (VLAX-3D-POINT ptins) ) (vla-delete (vlax-ename->vla-object ent)) (vlax-vla-object->ename vlaEnt) ) (T (alert "Tipo de objeto no es TEXT ni MTEXT") nil ) ) ) (redraw selEnt 3) (if 1x1? (grdraw (centroTexto (entget selEnt)) (cdr (assoc 10 (entget ent))) 1 2 ) ) (initget 1 "SKIP SELECT YES") (if (or (not 1x1?) (member (setq opt (strcase (getstring "\n*** Align this text? [sKip/Select other/<Yes>] : "))) '("Y" "") ) ) (if (or (and selEnt (setq textObj (obj->txMC selEnt))) (and (setq selEnt (car (entsel "\nText not found. Select text..."))) (wcmatch (cdr (assoc 0 (entget selEnt))) "*TEXT") (setq textObj (obj->txMC selEnt))) ) (vl-cmdf "_move" textObj "" (cdr (assoc 11 (entget textObj))) (cdr (assoc 10 (entget ent))) ) (princ "\n*** OMITED ***") ) (if (and (not (redraw selEnt 4)) (member opt '("S" "SELECT")) ) (if (and (setq selEnt (car (entsel))) (wcmatch (cdr (assoc 0 (entget selEnt))) "*TEXT") ) (if (and (not (redraw selEnt 3)) (setq textObj (obj->txMC selEnt)) ) (vl-cmdf "_move" textObj "" (cdr (assoc 11 (entget textObj))) (cdr (assoc 10 (entget ent))) ) ) ) ) ) (redraw selEnt 4) ) (setq n 0 osmant (getvar "OSMODE")) (setvar "OSMODE" 0) (princ "\nSelect circles...") (if (setq conj (ssget '((0 . "CIRCLE") (8 . "*")))) (progn (initget 1 "NO YES") (setq 1x1? (getkword "\nDo you want analyze circle by circle? [No/<Yes>]: ")) (if (= 1x1? "YES") (setq 1x1? T) (setq 1x1? nil) ) (while (setq ent (ssname conj n)) (setq lstent (entget ent) pto (cdr (assoc 10 lstent)) rad (cdr (assoc 40 lstent)) selEnt nil distMin nil n (+ n 1) ) (if 1x1? (vl-cmdf "_zoom" (setq pt1 (list (- (car pto) (* rad 10.0)) (- (cadr pto) (* rad 10.0)))) (setq pt2 (list (+ (car pto) (* rad 10.0)) (+ (cadr pto) (* rad 10.0))))) (setq pt1 (list (- (car pto) (* rad 10.0)) (- (cadr pto) (* rad 10.0))) pt2 (list (+ (car pto) (* rad 10.0)) (+ (cadr pto) (* rad 10.0))) ) ) (if (setq conj1 (ssget "_W" pt1 pt2 '((0 . "*TEXT")))) (progn (foreach ent1 (mapcar 'cadr (vl-remove-if-not (function (lambda (x) (member (car x) '(0 2 3)))) (ssnamex conj1))) (if distMin (if (< (setq dist (distance pto (setq pto1 (cdr (assoc 10 (entget ent1)))))) distmin) (setq selEnt ent1 distMin dist) ) (setq distMin (distance pto (cdr (assoc 10 (entget ent1)))) selEnt ent1 ) ) ) (AlignTxtToCircle ent selEnt) (redraw) ) ) ) ) ) (setvar "OSMODE" osmant) (redraw) (princ) )

In case I have not made myself clear, I will briefly explain how my approach would be: -Make a selection set of the hatches that may contain buildings -For each hatch: 1) obtain its outline with 'hatchedit' and identify it with 'entlast' (as I explained above) 2) make a selection set of the buildings contained in the window returned by 'getboundingbox'. 3) analyze with 'vla-intersectwith' each building selected in the previous step and identify the buildings included and/or intersected by the outline(s). 4) save the results in a file (excel, txt... etc)

@nikon The text within circles looks like you should be using a block with an attribute rather than two separate objects.

If its pline/lines then i would have a good guess at Clockwise v's anti clockwise, it will make stuff go inside or out depending on direction, simple to check for. Also for plines need to use which segment selected not just pt1->pt2 etc. (defun getplineseg ( / elst ename pt param preparam postparam) (setq elst (entsel "\nSelect pline segment: ")) (setq ename (car elst)) (setq pt (cadr elst)) (setq pt (vlax-curve-getClosestPointTo ename pt)) (print (setq param (vlax-curve-getParamAtPoint ename pt)) ) (print (setq preparam (fix param)) ) (print (setq postparam (1+ preparam)) ) (setq pt1 (vlax-curve-getPointAtParam ename preparam) pt2 (vlax-curve-getPointAtParam ename postparam)) )