See the top rated post in this thread. Click here

Results 1 to 9 of 9

Thread: Adding A Background Mask & Feet Squared To A LISP Routine

  1. #1
    Member
    Join Date
    2018-10
    Posts
    6
    Login to Give a bone
    0

    Default Adding A Background Mask & Feet Squared To A LISP Routine

    Hi,

    This is my first post here and was hoping i could get some help or guidance to modify a lisp routine.
    Based on Lee Macs great routine A2F (Area To Field) with some modifications done at a previous company, i am looking at adding a background mask for the text and if possible also adding feet squared to the lisp routine so that the calculation for the area will show as both meters squared and feet squared.
    I am very limited to LISP coding and would really appreciate any help with this.
    Attached Files Attached Files

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

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    To add Background Mask change:
    Code:
    				(vla-addmtext
    					(vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
    					(vlax-3D-point (trans ins 1 0))
    					0.0
    					str
    				)
    to
    Code:
                    (progn
    				  (vla-addmtext
    					  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
    					  (vlax-3D-point (trans ins 1 0))
    					  0.0
    					  str
    				  )
    				  (setq obj (vlax-ename->vla-object (entlast)))
    				  (vlax-put-property obj 'BackgroundFill :vlax-true)
                    )
    You're going to need to add two separate fields in that Mtext, one for m² and one for ft². Do you want them as two lines or one?
    It would be easier if you attached a drawing with a closed polyline with an Mtext label displayed as you want it. The fields depend on unit settings in the drawing and would not display the same on my drawings set to feet.
    Tom Beauford P.S.M. - Civil 2019 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
    2018-10
    Posts
    6
    Login to Give a bone
    0

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    Hi Tom,

    Thanks for your help on this.

    I have attached a drawing with an example of how i would like the text, but in saying that even if it is on 2 lines that is ok.

    Really appreciate your help on this.

    Scott
    Attached Files Attached Files

  4. #4
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,199
    Login to Give a bone
    1

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    Try this version:
    Code:
    ;;------------------------=={ Areas to Field }==------------------------;;
    ;;                                                                      ;;
    ;;  This program allows a user to create an MText object containing a   ;;
    ;;  Field Expression referencing the area, or sum of areas, of one or   ;;
    ;;  more selected objects.                                              ;;
    ;;                                                                      ;;
    ;;  Upon issuing the command syntax 'A2F' at the AutoCAD command-line,  ;;
    ;;  the user is prompted to make a selection of objects for which to    ;;
    ;;  retrieve the area; if more than one object is selected, the         ;;
    ;;  cumulative area for all objects will be displayed by the resultant  ;;
    ;;  MText Field.                                                        ;;
    ;;                                                                      ;;
    ;;  Following object selection, the user is prompted to pick a point    ;;
    ;;  at which to create the MText Field. If the specified point resides  ;;
    ;;  within an AutoCAD table cell, the program will populate the table   ;;
    ;;  cell with the appropriate Field Expression.                         ;;
    ;;                                                                      ;;
    ;;  The Field will display the sum of the areas of the selected         ;;
    ;;  objects, formatted using the Field formatting code specified at     ;;
    ;;  the top of the program - this formatting code may be altered to     ;;
    ;;  suit the user's requirements.                                       ;;
    ;;                                                                      ;;
    ;;----------------------------------------------------------------------;;
    ;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
    ;;----------------------------------------------------------------------;;
    ;;  Version 1.3    -    2014-07-17                                      ;;
    ;;----------------------------------------------------------------------;;
    ;;  Modifications completed to suit specific requirements OCT 2016      ;;
    ;;  Further updates October 2019                                        ;;
    ;;----------------------------------------------------------------------;;
    ;
    (defun c:a2fm ( / *error* fmt prop inc ins lst sel str )
     (setq oldtextstyle (getvar "textstyle")) ;added by MC
     (setvar "textstyle" "ARIAL")  ;added by SW
     (setq oldlay (getvar "clayer")) ;added by MC
     (setvar "clayer" "1_5_TEXT")     ;added by SW
     (command "color" "bylayer")     ;added by MC
    
        ;(setq fmt "%lu2%pr1%ps%ct8[1e-006]% m²%qf1") ;; Field Formatting
        (setq fmt "%lu2%pr1%ps%ct8[1e-006]%th44%qf1% m²")
        (setq ftfmt "%lu2%qf1%pr0% ft²%ct8[1.076391041670998E-005]%th44")
    
        (defun *error* ( msg )
            (LM:endundo (LM:acdoc))
            (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
                (princ (strcat "\nError: " msg))
            )
            (princ)
        )
    
        (if (and (setq sel (ssget '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE"))))
                 (setq ins (getpoint "\nPick point or cell for field: "))
            )
            (progn
                (if (setq tmp
                        (ssget "_X"
                            (list '(0 . "ACAD_TABLE")
                                (if (= 1 (getvar 'cvport))
                                    (cons 410 (getvar 'ctab))
                                   '(410 . "Model")
                                )
                            )
                        )
                    )
                    (repeat (setq idx (sslength tmp))
                        (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
                    )
                )
                (if (= 1 (sslength sel))
                    (setq str
                        (strcat
                            "%<\\AcObjProp Object(%<\\_ObjId "
                            (LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
                            ">%).Area \\f \"" fmt "\">%"
                            " "
                            "%<\\AcObjProp Object(%<\\_ObjId "
                            (LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
                            ">%).Area \\f \"" ftfmt "\">%"
                        )
                    )
                    (progn
                        (repeat (setq idx (sslength sel))
                            (setq lst
                                (vl-list*
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                                    ">%).Area>%" " + "
                                    lst
                                )
                            )
                        )
                        (setq str
                            (strcat
                                "%<\\AcExpr "
                                (apply 'strcat (reverse (cdr (reverse lst))))
                                " \\f \"" fmt "\">%"
                                " "
                                "%<\\AcExpr "
                                (apply 'strcat (reverse (cdr (reverse lst))))
                                " \\f \"" ftfmt "\">%"
                            )
                        )
                    )
                )
                (princ "\nstr = ")(princ str)
                (LM:startundo (LM:acdoc))
                (if (setq tmp (LM:getcell tab (trans ins 1 0)))
                    (apply 'vla-settext (append tmp (list str)))
                    (progn
    				  (vla-addmtext
    					  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
    					  (vlax-3D-point (trans ins 1 0))
    					  0.0
    					  str
    				  )
    				  (setq obj (vlax-ename->vla-object (entlast)))
    				  (vlax-put-property obj 'BackgroundFill :vlax-true)
                    )
                )
                (LM:endundo (LM:acdoc))
            )
        )
    (setvar "textstyle" oldtextstyle)  ;reset by MC
    (setvar "clayer" oldlay)
    (setvar "cmdecho" 0)
    (command "move" "L" "" "D" "@0,250") ;added by MC
    (command "justifytext" "L" "" "BL")
    (setvar "cmdecho" 1)
    (princ)
    )
    
    ;; ObjectID
    ;; Returns a string containing the ObjectID of a supplied VLA-Object
    ;; Compatible with 32-bit & 64-bit systems
    
    (defun LM:ObjectID ( obj )
        (eval
            (list 'defun 'LM:ObjectID '( obj )
                (if
                    (and
                        (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                        (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    )
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(itoa (vla-get-objectid obj))
                )
            )
        )
        (LM:ObjectID obj)
    )
    
    ;; Get Cell
    ;; If the supplied point lies within a cell boundary,
    ;; returns a list of: (<VLA Table Object> <Row> <Col>)
    
    (defun LM:getcell ( lst pnt / dir )
        (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
              pnt (vlax-3D-point pnt)
        )
        (vl-some
           '(lambda ( tab / row col )
                (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                    (list tab row col)
                )
            )
            lst
        )
    )
    
    ;; Start Undo
    ;; Opens an Undo Group.
    
    (defun LM:startundo ( doc )
        (LM:endundo doc)
        (vla-startundomark doc)
    )
    
    ;; End Undo
    ;; Closes an Undo Group.
    
    (defun LM:endundo ( doc )
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (vla-endundomark doc)
        )
    )
    
    ;; Active Document
    ;; Returns the VLA Active Document Object
    
    (defun LM:acdoc nil
        (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
        (LM:acdoc)
    )
    
    (vl-load-com) (princ)
    ;;
    Tom Beauford P.S.M. - Civil 2019 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

  5. #5
    Member
    Join Date
    2018-10
    Posts
    6
    Login to Give a bone
    0

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    Thanks Tom,

    But that didn't seem to work, i kept getting the following message:
    Pick point or cell for field:
    str = %<\AcObjProp Object(%<\_ObjId 1819856010144>%).Area \f "%lu2%pr1%ps%ct8[1e-006]%th44%qf1% m²">% %<\AcObjProp Object(%<\_ObjId 1819856010144>%).Area \f "%lu2%qf1%pr0% ft²%ct8[1.076391041670998E-005]%th44">%

    then it just stops.

  6. #6
    Member
    Join Date
    2018-10
    Posts
    6
    Login to Give a bone
    0

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    Hi Again Tom,

    Please disregard, it working perfectly.
    Really Appreciate your help on this.

    Scott

  7. #7
    Member
    Join Date
    2018-10
    Posts
    6
    Login to Give a bone
    0

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    I have another one that i have been trying to work out and im really not getting anywhere. The attached lisp lets you select closed polyline areas to add, then select another closed polyline to subtract. I also need to have a background mask around the text as well as add ft².

    I have also attached an example drawing. So in the end i can select the big rectangle then subtract to small rectangle to give an area of the remaining space. This should read in both m² and ft² with a background mask as with the previous drawing.


    Once again thanks for the help.
    Attached Files Attached Files

  8. #8
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,199
    Login to Give a bone
    1

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    This should do what you want:
    Code:
    ;;  ------------------------------------------------------------------  ;;
    ;;  NA (Net Area)                                                       ;;
    ;;  ------------------------------------------------------------------  ;;
    ;;  This Command will calculate an area while also subtracting any      ;;
    ;;  Area selected by user                                               ;;
    ;;  ------------------------------------------------------------------  ;;
    ;
    (defun c:NA  (/ ss1 ss2 i mtvalue1 mtvalue2 varlst obj)
    	(princ "\nNet area calculation")
    	(setq oldlayer (getvar "clayer"))
    	(setvar "clayer" "1_5_TEXT")
    	(command "-color" "bylayer") ;;edit by MC
    	(command "_-style" "FIXTURE PLAN AREA" "ARIAL" "250" "" "" "" "")
      (setq varlst (mapcar 'getvar (list 'cmdecho 'nomutt)))
     ; (mapcar 'setvar (list 'cmdecho 'nomutt) (list 0 1))
      (prompt "\nSelect Polylines to Add: ")
      (setq ss1 (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>"))))
      ;(mapcar 'setvar (list 'cmdecho 'nomutt) (list 1 0))
      (prompt "\nSelect Polylines to Subtract: ")
     ; (mapcar 'setvar (list 'cmdecho 'nomutt) (list 0 1))
      (setq ss2 (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))
            i   0)
      (repeat (sslength ss1)
        (setq mtvalue1 (strcat (if mtvalue1
                                 mtvalue1
                                 "")
                               (itoa (vla-get-objectID (vlax-ename->vla-object (ssname ss1 i))))
                               ">%).Area \\f \"%lu2%pr1%ps[, m²]%ct8[1e-006]\">%+%<\\AcObjProp Object(%<\\_ObjId ")
              i        (1+ i)))
      (setq i 0)
      (repeat (sslength ss2)
        (setq mtvalue2 (strcat (if mtvalue2
                                 mtvalue2
                                 "")
                               (itoa (vla-get-objectID (vlax-ename->vla-object (ssname ss2 i))))
                               ">%).Area \\f \"%lu2%pr1%ps[, m²]%ct8[1e-006]\">%-%<\\AcObjProp Object(%<\\_ObjId ")
              i        (1+ i)))
      (mapcar 'setvar (list 'cmdecho 'nomutt) (list 1 0))
      (prompt "\nSelect Net Area insertion point: ")
      (vla-addmtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                    (vlax-3d-point (getpoint))
                    0
                    (strcat "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
                            (vl-string-right-trim "+%<\\AcObjProp Object(%<\\_ObjId " mtvalue1)
                            "%-%<\\AcObjProp Object(%<\\_ObjId "
                            (vl-string-right-trim "-%<\\AcObjProp Object(%<\\_ObjId " mtvalue2)
                            "%) \\f \"%lu2%pr1%ps[, m²]%ct8[1e-006]\">%"
                            " "
                            "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
                            (vl-string-right-trim "+%<\\AcObjProp Object(%<\\_ObjId " mtvalue1)
                            "%-%<\\AcObjProp Object(%<\\_ObjId "
                            (vl-string-right-trim "-%<\\AcObjProp Object(%<\\_ObjId " mtvalue2)
                            "%) \\f \"%lu2%qf1%pr0% ft²%ct8[1.076391041670998E-005]%th44\">%"
                    )
      )
       (setq obj (vlax-ename->vla-object (entlast)))
       (vlax-put-property obj 'BackgroundFill :vlax-true)
       (mapcar 'setvar (list 'cmdecho 'nomutt) varlst)
       (command "justifytext" "L" "" "BL")
       (setvar "clayer" oldlayer)  ;restore old layer
       (setvar "cmdecho" 0)
       (command "move" "L" "" "d" "@0,250")
       (setvar "cmdecho" 1)
      (princ)
    )
    ;;
    ;;
    ;;-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    Tom Beauford P.S.M. - Civil 2019 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

  9. #9
    Member
    Join Date
    2018-10
    Posts
    6
    Login to Give a bone
    0

    Default Re: Adding A Background Mask & Feet Squared To A LISP Routine

    Thanks again Tom, This is fantastic.

    Really appreciate your help with this.

    Scott

Similar Threads

  1. Replies: 6
    Last Post: 2018-05-15, 11:18 AM
  2. 2013: BOM Occurance Base Unit in Square Feet instead of Linear Feet or Each
    By darrell.badger in forum Inventor - General
    Replies: 0
    Last Post: 2013-07-01, 10:28 PM
  3. greater than or equal two a squared
    By Bryan Thatcher in forum Revit Architecture - General
    Replies: 6
    Last Post: 2010-10-25, 05:38 PM
  4. Squared
    By krlee_399 in forum Revit Structure - General
    Replies: 2
    Last Post: 2010-06-14, 02:06 PM
  5. Roof slab edge cut - custom squared
    By Yancka in forum ACA General
    Replies: 1
    Last Post: 2010-02-25, 10:04 AM

Tags for this Thread

Posting Permissions

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