Jump to content

Boundary Creation Lisp- by Text selections

zefreestijl

By zefreestijl
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

zefreestijl Newbie

zefreestijl

Posted
Posted
A while statement would be what you want...

 

(defun c:BND (/ pt)
 (while (setq pt (getpoint "\nPick internal point: "))
   (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
 )
 (princ)
)

 

Thread: Boundary Creation Lisp- a request

 

 

HI,

 

 

I just learned how to create boundary smoothly from the above post.

 

is there a way to create boundary by the coordinates of selected Texts?

 

1.jpg

 

 

Thanks!

Link to comment
Share on other sites
ziele_o2k Community Regular

ziele_o2k

Posted
Posted

Something like that?

(defun c:BNDTXT (/ pt)
 (while (setq pt (cdr (assoc 10 (entget (ssname(ssget "_+.:E:S" '((0 . "TEXT"))) 0)))))
   (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
 )
 (princ)
)

Link to comment
Share on other sites
ziele_o2k Community Regular

ziele_o2k

Posted
Posted

Or like that?

(defun c:BNDTXTMULTIPLE (/ pt)
(if (setq ss (ssget '((0 . "TEXT"))))
	(repeat (setq in (sslength ss))
		(setq pt (cdr (assoc 10 (entget (ssname ss (setq in (1- in)))))))
		(command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
	)
)
(princ)
)

Link to comment
Share on other sites
tombu Veteran

tombu

Posted
Posted

Try:

;;; 2000+ version
;;; Tbox.lsp - Draws boxes around Text, Mtext, Attributes & Dimension Text.
;;; BY: TOM BEAUFORD
;;; tombu@leoncountyfl.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
;========================================================================
(defun c:tbox (/ *ERROR* thisdrawing EnTyp ENT EnPt SubE SEnTyp Blk BOBJ
                 elist EOBJ ELA rot of ps AtPt ss tb of ll lr ul ur)
 (vl-load-com)

 (defun *ERROR* (err) ; define local handler
  (princ)
 );; "" is the same message you get when exiting an AutoCAD command.

 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
 (setvar "cmdecho" 0)
 (setq ENT "Something")
 (while ENT
   (while(not(or(= EnTyp "ATTRIB")(= EnTyp "ATTDEF")(= EnTyp "TEXT")(= EnTyp "MTEXT")))
     (if(not(= EnTyp nil))(prompt "\nEntity Selected not an Attribute or Text"))
     (if(setq ENT (entsel "\nSelect Attribute or Text: "))
       (setq EnTyp (cdr (assoc 0 (entget (car ENT))))
             EnPt (cadr ENT)
             ENT (car ENT)	; Entity name
             SubE (car (nentselp "" EnPt))		; SubEntity
             SEnTyp (cdr (assoc 0 (entget SubE)))		; SubEntity type
       ); setq
       (setq ENT nil EnTyp nil SEnTyp nil)
     ); if
     (cond
       ((= SEnTyp "ATTRIB")(setq ENT SubE EnTyp SEnTyp SubE nil SEnTyp nil))
       ((= EnTyp "DIMENSION")
         (progn
           (princ "\nEnTyp = Dimension.")
           (setq Blk ENT		; Parent entity name
                 ENT SubE
                 BOBJ (vlax-ename->vla-object Blk)	; Entity object
                 EnTyp SEnTyp
                 SubE nil
                 SEnTyp nil
           ); setq
         ); progn
       ); EnTyp = "DIMENSION"
       (ENT(princ "\nEnTyp is not a Dimension, Insert or Attribute."))
     ); cond
     (setq elist (entget ENT); Entity list
     )
     (setq EOBJ (vlax-ename->vla-object ENT)	; Entity object
    	   ELA (getvar "clayer")	; Object layer
     );;setq
;      (if Blk(vlax-dump-object (vlax-ename->vla-object Blk)))
;      (vlax-dump-object EOBJ)	; List object properties
     (if(acet-layer-locked ELA)	; If object layer's locked
       (progn
         (prompt(strcat "Current Layer \"" ELA "\" is Locked."))
         (setq EnTyp nil)	; continue while loop
       )
     )
   );;while
 
   (setq rot (vlax-get-property EOBJ 'Rotation)
          of (vlax-get-property EOBJ 'Height)
          ps (vlax-safearray->list(vlax-variant-value (vlax-get-property EOBJ 'InsertionPoint)))
   )
   (vla-startundomark thisdrawing)
   (cond
     ((= EnTyp "MTEXT")
       (progn
         (if Blk (setq of (*(vlax-get-property BOBJ 'TextGap)2)))
         (setq AtPt (vlax-get-property EOBJ 'AttachmentPoint))
         (cond
           ((or(= 1 AtPt)(= 4 AtPt)(= 7 AtPt))(setq  ps (polar ps(+ rot PI)(/ of 2))))
           ((or(= 2 AtPt)(= 5 AtPt)(= 8 AtPt))
             (setq  ps (polar ps(+ rot PI)(/ (+ (cdr(assoc 42 elist))of) 2)))
           )
           ((or(= 3 AtPt)(= 6 AtPt)(= 9 AtPt))
             (setq  ps (polar ps(+ rot PI)(+ (cdr(assoc 42 elist))(/ of 2))))
           )
         )
         (cond
           ((or(= 1 AtPt)(= 2 AtPt)(= 3 AtPt))(setq  ps (polar ps(+ rot(/ PI 2))(/ of 2))))
           ((or(= 4 AtPt)(= 5 AtPt)(= 6 AtPt))
             (setq  ps (polar ps(+ rot(/ PI 2))(/ (+ (cdr(assoc 43 elist))of) 2)))
           )
           ((or(= 7 AtPt)(= 8 AtPt)(= 9 AtPt))
             (setq  ps (polar ps(+ rot(/ PI 2))(+ (cdr(assoc 43 elist))(/ of 2))))
           )
         )
         (setq  lr (polar ps rot (+ (cdr(assoc 42 elist))of))
                ul (polar ps (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
                ur (polar lr (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
         )
         (vl-cmdf "pline" "non" ps "non" ul "non" ur "non" lr "c")	;Drawn Box
       ); progn
     ); EnTyp = "MTEXT"
     ((or(= EnTyp "ATTRIB")(= EnTyp "TEXT"))
       (progn
         (if(= EnTyp "ATTRIB")
            (setq
              elist(subst(cons 73 (cdr(assoc 74 elist)))(assoc 74 elist)elist)
              elist(subst(cons 0 "TEXT")(assoc 0 elist)elist)
            )
         ); if
         (vl-cmdf "ucs" "OBject" ENT)
         (setq tb (textbox elist)
               ll (list(-(car(car tb))(/ of 6))(-(cadr(car tb))(/ of 6)))
               ur (list(+(car(cadr tb))(/ of 6))(+(cadr(cadr tb))(/ of 6)))
         )
         (vl-cmdf "rectang" "non" ll "non" ur)	;Drawn Box
         (vl-cmdf "ucs" "p")
       ); progn
     ); EnTyp = "ATTRIB" or "TEXT"
   ); cond
   (setq Box (vlax-ename->vla-object (entlast)))
   (vl-catch-all-apply 'vla-put-Linetype (list Box "CONTINUOUS"))
   (vl-catch-all-apply 'vla-put-ConstantWidth (list Box (/ of 20)))
   (setq EnTyp nil SEnTyp nil)
   (vla-endundomark thisdrawing)
 ); while
 (princ)
); defun

Link to comment
Share on other sites
zefreestijl Newbie

zefreestijl

Posted
  • Author
Posted
Or like that?

(defun c:BNDTXTMULTIPLE (/ pt)
(if (setq ss (ssget '((0 . "TEXT"))))
	(repeat (setq in (sslength ss))
		(setq pt (cdr (assoc 10 (entget (ssname ss (setq in (1- in)))))))
		(command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
	)
)
(princ)
)

 

Yes! It works!

 

Thank you so much!!

 

Now I can use this lisp to find a boundary of structural slabs,

 

Thanks again.

Link to comment
Share on other sites
zefreestijl Newbie

zefreestijl

Posted
  • Author
Posted
Try:
;;; 2000+ version
;;; Tbox.lsp - Draws boxes around Text, Mtext, Attributes & Dimension Text.
;;; BY: TOM BEAUFORD
;;; tombu@leoncountyfl.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
;========================================================================
(defun c:tbox (/ *ERROR* thisdrawing EnTyp ENT EnPt SubE SEnTyp Blk BOBJ
                 elist EOBJ ELA rot of ps AtPt ss tb of ll lr ul ur)
 (vl-load-com)

 (defun *ERROR* (err) ; define local handler
  (princ)
 );; "" is the same message you get when exiting an AutoCAD command.

 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
 (setvar "cmdecho" 0)
 (setq ENT "Something")
 (while ENT
   (while(not(or(= EnTyp "ATTRIB")(= EnTyp "ATTDEF")(= EnTyp "TEXT")(= EnTyp "MTEXT")))
     (if(not(= EnTyp nil))(prompt "\nEntity Selected not an Attribute or Text"))
     (if(setq ENT (entsel "\nSelect Attribute or Text: "))
       (setq EnTyp (cdr (assoc 0 (entget (car ENT))))
             EnPt (cadr ENT)
             ENT (car ENT)	; Entity name
             SubE (car (nentselp "" EnPt))		; SubEntity
             SEnTyp (cdr (assoc 0 (entget SubE)))		; SubEntity type
       ); setq
       (setq ENT nil EnTyp nil SEnTyp nil)
     ); if
     (cond
       ((= SEnTyp "ATTRIB")(setq ENT SubE EnTyp SEnTyp SubE nil SEnTyp nil))
       ((= EnTyp "DIMENSION")
         (progn
           (princ "\nEnTyp = Dimension.")
           (setq Blk ENT		; Parent entity name
                 ENT SubE
                 BOBJ (vlax-ename->vla-object Blk)	; Entity object
                 EnTyp SEnTyp
                 SubE nil
                 SEnTyp nil
           ); setq
         ); progn
       ); EnTyp = "DIMENSION"
       (ENT(princ "\nEnTyp is not a Dimension, Insert or Attribute."))
     ); cond
     (setq elist (entget ENT); Entity list
     )
     (setq EOBJ (vlax-ename->vla-object ENT)	; Entity object
    	   ELA (getvar "clayer")	; Object layer
     );;setq
;      (if Blk(vlax-dump-object (vlax-ename->vla-object Blk)))
;      (vlax-dump-object EOBJ)	; List object properties
     (if(acet-layer-locked ELA)	; If object layer's locked
       (progn
         (prompt(strcat "Current Layer \"" ELA "\" is Locked."))
         (setq EnTyp nil)	; continue while loop
       )
     )
   );;while
 
   (setq rot (vlax-get-property EOBJ 'Rotation)
          of (vlax-get-property EOBJ 'Height)
          ps (vlax-safearray->list(vlax-variant-value (vlax-get-property EOBJ 'InsertionPoint)))
   )
   (vla-startundomark thisdrawing)
   (cond
     ((= EnTyp "MTEXT")
       (progn
         (if Blk (setq of (*(vlax-get-property BOBJ 'TextGap)2)))
         (setq AtPt (vlax-get-property EOBJ 'AttachmentPoint))
         (cond
           ((or(= 1 AtPt)(= 4 AtPt)(= 7 AtPt))(setq  ps (polar ps(+ rot PI)(/ of 2))))
           ((or(= 2 AtPt)(= 5 AtPt)(= 8 AtPt))
             (setq  ps (polar ps(+ rot PI)(/ (+ (cdr(assoc 42 elist))of) 2)))
           )
           ((or(= 3 AtPt)(= 6 AtPt)(= 9 AtPt))
             (setq  ps (polar ps(+ rot PI)(+ (cdr(assoc 42 elist))(/ of 2))))
           )
         )
         (cond
           ((or(= 1 AtPt)(= 2 AtPt)(= 3 AtPt))(setq  ps (polar ps(+ rot(/ PI 2))(/ of 2))))
           ((or(= 4 AtPt)(= 5 AtPt)(= 6 AtPt))
             (setq  ps (polar ps(+ rot(/ PI 2))(/ (+ (cdr(assoc 43 elist))of) 2)))
           )
           ((or(= 7 AtPt)(= 8 AtPt)(= 9 AtPt))
             (setq  ps (polar ps(+ rot(/ PI 2))(+ (cdr(assoc 43 elist))(/ of 2))))
           )
         )
         (setq  lr (polar ps rot (+ (cdr(assoc 42 elist))of))
                ul (polar ps (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
                ur (polar lr (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
         )
         (vl-cmdf "pline" "non" ps "non" ul "non" ur "non" lr "c")	;Drawn Box
       ); progn
     ); EnTyp = "MTEXT"
     ((or(= EnTyp "ATTRIB")(= EnTyp "TEXT"))
       (progn
         (if(= EnTyp "ATTRIB")
            (setq
              elist(subst(cons 73 (cdr(assoc 74 elist)))(assoc 74 elist)elist)
              elist(subst(cons 0 "TEXT")(assoc 0 elist)elist)
            )
         ); if
         (vl-cmdf "ucs" "OBject" ENT)
         (setq tb (textbox elist)
               ll (list(-(car(car tb))(/ of 6))(-(cadr(car tb))(/ of 6)))
               ur (list(+(car(cadr tb))(/ of 6))(+(cadr(cadr tb))(/ of 6)))
         )
         (vl-cmdf "rectang" "non" ll "non" ur)	;Drawn Box
         (vl-cmdf "ucs" "p")
       ); progn
     ); EnTyp = "ATTRIB" or "TEXT"
   ); cond
   (setq Box (vlax-ename->vla-object (entlast)))
   (vl-catch-all-apply 'vla-put-Linetype (list Box "CONTINUOUS"))
   (vl-catch-all-apply 'vla-put-ConstantWidth (list Box (/ of 20)))
   (setq EnTyp nil SEnTyp nil)
   (vla-endundomark thisdrawing)
 ); while
 (princ)
); defun

 

This one works, too!

 

Thank you for your help!

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.

×
 Share
Go to topic listing
×
×
  • Create New...