Author Topic: Adding and subtracting dimensions with lisp.  (Read 11456 times)

0 Members and 1 Guest are viewing this topic.

KOWBOI

  • Guest
Adding and subtracting dimensions with lisp.
« on: February 22, 2010, 03:28:14 PM »
I have a lisp routine that is supposed to add or subtract dimensions. It works fine with horizontal or aligned dimensions but not with vertical dimensions. Any Ideas on this?

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #1 on: February 22, 2010, 03:58:43 PM »
Could you post what you have, and perhaps we can help a bit better  ;-)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Adding and subtracting dimensions with lisp.
« Reply #2 on: February 22, 2010, 04:00:51 PM »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #3 on: February 22, 2010, 05:02:25 PM »
Wow, thanks, this is almost exactly what I wanted. I would also like to be able to place the total on the drawing. My lisp skills are meager and I'm almost afraid to hack at this one to do that. Any suggestions? TIA.

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #4 on: February 22, 2010, 05:04:21 PM »
I forgot to add. Thanks to SMadsen for the lisp, great job!

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Adding and subtracting dimensions with lisp.
« Reply #5 on: February 22, 2010, 05:51:25 PM »
This may work for you:
Code: [Select]
;;; TXTSUM.LSP by Stig
;;; Routine that allows for pick of text, dimensions and attributes
;;; in order to do calculation with numbers in the text. Valid are
;;; strings that entirely represents a number or that has a number
;;; at the leftmost position, which is separated from alpha characters
;;; with a space, tabulation, quote or double quote (newline character
;;; in MTEXT is not a valid separator!).
;;; Units allowed by LUNITS are valid. If a number of any format
;;; is not separated by the above characters from alpha characters,
;;; it will not be regarded as a number (normal behavior of READ).
;;; No angle units are handled, - only linear units.
;;; NOTE: For dimensions, only the actual measurement will be read.

(defun getNent_kWords (msg lst kwords / ent)
  (setvar "ERRNO" 0)
  (and (not msg) (setq msg "\nSelect object: "))
  (while (and (not ent) (/= (getvar "ERRNO") 52))
    (and kwords (initget kwords))
    (setq ent (nentsel msg))
    (cond
      ((= (type ent) 'STR))
      ((vl-consp ent)
       (cond ((> (length ent) 2)
              (cond
                ((member (cdr (assoc 0 (entget (last (last ent))))) lst)
                 (setq ent (last (last ent))))
                ((member (cdr (assoc 0 (entget (car ent)))) lst)
                 (setq ent (car ent)))
                ((princ "\nNot a valid object") (setq ent nil))
              )
             )
             ((member (cdr (assoc 0 (entget (car ent)))) lst)
              (setq ent (car ent)))
             ((princ "\nNot a valid object") (setq ent nil))
       )
      )
    )
  )
  ent
)


(defun C:TXTSUM (/ ent entl func cont txtsum lastsum undosum used useUsed)
  (defun printCurrent (sum) (and sum (princ (strcat "\nCurrent result: " (rtos sum)))))
  (vl-load-com)
  (setq func '+)
  (while (setq ent (getNent_kWords
                    (strcat "\nSelect text or [+/-/*/Div/Undo] (current: "
                            (vl-princ-to-string func) "): ")
                    '("TEXT" "MTEXT" "DIMENSION" "ATTRIB")
                    "+ - * Div / Undo"
                  )
         )
    (cond
      ;; if entity of type TEXT, MTEXT or DIMENSION go get supposed number ...
      ((= (type ent) 'ENAME)
       (setq entl (entget ent))
       (cond ((member (cdr (assoc 0 entl)) '("TEXT" "MTEXT" "ATTRIB"))
              (setq cont (cdr (assoc 1 entl)))
              ;; figure out the format with various DISTOF units.
              ;; if no DISTOF format is recognized, simply READ it
              ;; and see if something can be obtained from the string
              (setq cont
                     (cond
                       ((distof cont 1))
                       ((distof cont 2))
                       ((distof cont 3))
                       ((distof cont 4))
                       ((distof cont 5))
                       ((read cont)) ; get number if followed by a space "10 a" = 10
                       ;; (read "10a") = "10a" so you must test result with
                       ;;   (numberp "10a") results in 'not a number'
                     )
              )
             )
             ;; got a dimension .. just read the measurement
             ((= (cdr (assoc 0 entl)) "DIMENSION")
              (setq cont (cdr (assoc 42 entl)))
             )
       )
       (cond
         ((and (not txtsum)(numberp cont))
          (setq txtsum cont lastsum txtsum used (cons ent used))
          (printCurrent txtsum))
         ;; see if it really holds a number
         ((numberp cont)
          ;; add last result to undo list
          (setq undosum (cons lastsum undosum))
          ;; ... and see if it has already been used
          (if (cond ((member ent used)
                     (initget "Yes No")
                     (cond ((/= "No"
                              (getkword "\nAdd object already used? [Yes/No] <Yes>: "))
                            T)))
                    (T)
              )
            (progn
              (if (and (= func '/)(zerop cont))
                (princ "\nDivide by zero error")
                (setq txtsum (apply func (list txtsum cont))))
              (princ (strcat "\n" (rtos lastsum) " " (vl-princ-to-string func)
                             " " (rtos cont) " = " (rtos txtsum)))
            );_ progn
            (printCurrent txtsum)
          ) ; if
          (setq used (cons ent used) lastsum txtsum)
         ) ;_ numberp
         ((princ "\nNo numeric value found")(printCurrent txtsum))
       ) ;_ cond
      ) ;_ type ENAME
      ;; if string then it must have been returned by getEnt_kWords and
      ;; is either "+", "-", "*" or "Div" (or "/"). Go set up function to use
      ((= (type ent) 'STR)
       (cond ((= ent "Div") (setq func '/))
             ((= ent "Undo")
              ;; if undo can be done, go get the previous result and
              ;; chop off the undo list
              (if undosum
                (setq txtsum  (car undosum) lastsum txtsum undosum (cdr undosum))
                (princ "\nNothing to undo")
              )
              (printCurrent txtsum)
             )
             ((setq func (read ent)))
       )
      )
    ) ;_ cond
  ) ;_ while
  (and txtsum (princ (strcat "\nTotal: " (rtos txtsum))))
  ;;  Added by CAB 02.22.2010
  ;;-----------------------------------------------------------------
  (initget "Yes No")
  (if (/= (getkword "\nAdd total to drawing? [Yes/No] <Yes>: ") "No")
      (progn
(setq pt (trans (getvar 'viewctr) 1 0))
  (command "._undo" "_mark")
        (setq ent
       (entmakex
(list (cons 0 "TEXT") ;***
                 (cons 1 (rtos txtsum)) ;* (the string itself)
                 (cons 6 "BYLAYER") ; Linetype name
                 ;;(cons 8 "0")   ; layer
                 (cons 10 pt) ;* First alignment point (in OCS)
                 (cons 11 pt) ;* Second alignment point (in OCS)
                 (cons 40 (getvar "TextSize")) ;* Text height
                 )))
(princ "\nPick location.")
(command "._Move" ent "" "_non" Pt pause)
;;  Test for ENTER pressed ILO point picked
(if (equal 0.0 (distance Pt (getvar "lastpoint")) 0.0001)
  (command "._undo" "_back") ; & exit
)
      )
  )
  ;;-----------------------------------------------------------------
  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #6 on: February 23, 2010, 10:48:30 AM »
This is great, thank you so much CAB. Your skills are greatly appreciated!

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Adding and subtracting dimensions with lisp.
« Reply #7 on: February 23, 2010, 11:10:12 AM »
You're quite welcome.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #8 on: February 26, 2010, 12:39:42 PM »
What I want to use this routine for is to select two dimensions and multiply them so as to get the area and place that on the drawing.  I made some very minor, simple changes. It now defaults to multiply your selection and places the area to 2 decimal places on a specific layer that does not plot then switches back to the previous layer. However, our drawings are in millimeters and I need square feet and I have not been able to figure out what to change in the code to make this happen. CAB has been a huge help and I was hoping he might be able to take a shot a this since my lisp skills suck so bad. Thanks again.

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #9 on: February 26, 2010, 01:12:56 PM »
I work for a company that does granite counter tops and some of the are quite odd but when I get the area of a piece it needs to be squared off. I thought this might give you an idea of what I am talking about. Thanks again for all the help.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #10 on: February 26, 2010, 01:28:27 PM »
Instead of messing with dimensions, you could get the BoundingBox for the object, and use its area  :-)

Or you could use a field that links the two dimensions...  :-)

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #11 on: February 26, 2010, 01:42:30 PM »
Hows this for example?

Just knocked it up quickly:

Code: [Select]
(defun c:dimFld (/ e1 e2 pt)
  (vl-load-com) ;; Lee Mac  ~  26.02.10

  (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                             (vlax-get-acad-object)))))

  (if (and (setq e1 (car (entsel "\nSelect Dimension 1: ")))
           (eq "DIMENSION" (cdr (assoc 0 (entget e1))))
           (setq e2 (car (entsel "\nSelect Dimension 2: ")))
           (eq "DIMENSION" (cdr (assoc 0 (entget e2))))
           (setq pt (getpoint "\nSelect Point for Field: ")))

    (vla-AddMText

      (if (zerop (vla-get-ActiveSpace *doc))
        (if (eq :vlax-true (vla-get-Mspace *doc))
          (vla-get-ModelSpace *doc)
          (vla-get-PaperSpace *doc))
        (vla-get-ModelSpace *doc)) (vlax-3D-point pt) 0.

      (strcat "%<\\AcExpr "
              "%<\\AcObjProp Object(%<\\_ObjId "
              (itoa (vla-get-Objectid (vlax-ename->vla-object e1)))">%).Measurement >% * "
              "%<\\AcObjProp Object(%<\\_ObjId "
              (itoa (vla-get-Objectid (vlax-ename->vla-object e2)))">%).Measurement >% \\f \"%lu6\" >%")))

  (princ))
« Last Edit: February 26, 2010, 01:59:01 PM by Lee Mac »

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #12 on: February 26, 2010, 02:06:31 PM »
WOW! I didn't know that was even possible. Thanks so much for the help but I have to draw in millimeters and show the area in square feet. I also need it to be on a specific layer called NO_PLOT_LAYER. I know absolutely nothing about vl, vla, vlx or any of that or I would try and edit the code myself.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Adding and subtracting dimensions with lisp.
« Reply #13 on: February 26, 2010, 02:08:50 PM »
This may be the conversion. Untested
Code: [Select]
(setq SqFt (* Dim1 Dim2 0.000010764))
(princ (rtos SqFt 2 2))
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #14 on: February 26, 2010, 02:13:51 PM »
No worries, try this:

Code: [Select]
(defun c:dimFld (/ e1 e2 pt suff)
  (vl-load-com) ;; Lee Mac  ~  26.02.10

  (setq suff "sq.ft") ;; Suffix

  (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                             (vlax-get-acad-object)))))

  (or (tblsearch "LAYER" "NO_PLOT_LAYER")
      (vla-add (vla-get-layers *doc) "NO_PLOT_LAYER"))

  (if (and (setq e1 (car (entsel "\nSelect Dimension 1: ")))
           (eq "DIMENSION" (cdr (assoc 0 (entget e1))))
           (setq e2 (car (entsel "\nSelect Dimension 2: ")))
           (eq "DIMENSION" (cdr (assoc 0 (entget e2))))
           (setq pt (getpoint "\nSelect Point for Field: ")))

    (vla-put-layer
      (vla-AddMText

        (if (zerop (vla-get-ActiveSpace *doc))
          (if (eq :vlax-true (vla-get-Mspace *doc))
            (vla-get-ModelSpace *doc)
            (vla-get-PaperSpace *doc))
          (vla-get-ModelSpace *doc)) (vlax-3D-point pt) 0.

        (strcat "%<\\AcExpr "
                "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-Objectid (vlax-ename->vla-object e1)))">%).Measurement >% * "
                "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-Objectid (vlax-ename->vla-object e2)))">%).Measurement >%"
                " \\f \"%lu6%ps[, " suff "]%ct8[1.07639104e-005]\" >%"))
     
    "NO_PLOT_LAYER"))

  (princ))

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #15 on: February 26, 2010, 02:59:16 PM »
Thank you yet again. Is there a way I can add these fields together to get a total square footage and then select an attribute to place the total? I have an attribute on the title block for total square footage and previously I would use two different lisp routines. The first one would get the sqaure feet and place it on the drawing. It was not as cool as this though, I love that the field updates when the dims change. The second would let me select each individual text representing the square feet for that piece adding them up and then let me select the attribute in the title block to place the total there. That lisp does not work on fields. Thank you so much you guys are brilliant.

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: Adding and subtracting dimensions with lisp.
« Reply #16 on: February 26, 2010, 03:17:01 PM »
I really hope you take the time to explore the possibilities of Fields. While the provided routines are extremely helpful, they teach you nothing. Sometimes we are a little too eager to whip a little code out, not thinking of the person asking the questions and what they want/need.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #17 on: February 26, 2010, 03:28:28 PM »
Actually I just recently dicovered fields and I am trying to make as much use of them as possible. I've already changed our drawing format so that certain things are updated automatically.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #18 on: February 26, 2010, 03:54:58 PM »
As a modification of a routine by Gile  :-)

Code: [Select]
;; ADDFIELDS (gile)
;; Insert a text field wich value is the sum of selected fields

;; Modified by Lee Mac to Accept SelSet

(defun c:AddFields (/ *error* ATT CODE ENT I LST POS RES SS)
  (vl-load-com)

  (defun *error* (msg)
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))
 
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument
                              (vlax-get-acad-object))))

  (if (setq i -1 ss (ssget '((0 . "MTEXT,TEXT"))))
    (progn
     
      (while (setq ent (ssname ss (setq i (1+ i))))

        (if (and (setq code (gc:FieldCode ent))
                 (setq pos  (vl-string-search "%<" code))
                 (setq code (substr code (1+ pos)))
                 (setq pos  (vl-string-position 37 code 1 t))
                 (setq code (substr code 1 (1+ pos))))

          (if (assoc ent lst)
            (setq lst (vl-remove (assoc ent lst) lst))
            (setq lst (cons (cons ent code) lst)))))

      (if lst
        (while
          (progn
            (setq att (car (nentsel "\nSelect Attribute or Text for Field: ")))

            (cond (  (eq 'ENAME (type att))

                     (if (vl-position
                           (cdr (assoc 0 (entget att))) '("TEXT" "MTEXT" "ATTRIB"))
                       (progn

                         (setq code (cdr (last lst))

                               res (strcat "%<\\AcExpr "
                                           (lst2str (mapcar (function cdr) lst) " + ")
                                           " " (if (setq pos (vl-string-position (ascii "\\") code 1 t))
                                                 (substr code (1+ pos)) ">%")))

                         (vla-put-TextString
                           (vlax-ename->vla-object att) res)
                         
                         (vla-regen *acdoc* acActiveViewport))

                       (princ "\n** Object Must be Text, MText or Attrib **")))))))))
 
  (princ))


;;========================= ROUTINES =========================;;

;; gc:FieldCode (gile)
;; Returns the string value of a text mtext or attribute with field code
;;
;; Argument : the entity name (ENAME)

(defun gc:FieldCode (ent / foo elst xdict dict field str)

  ;;--------------------------------------------------------;;
  (defun foo (field str / pos fldID objID)
    (setq pos 0)
    (if (setq pos (vl-string-search "\\_FldIdx " str pos))
      (while (setq pos (vl-string-search "\\_FldIdx " str pos))
        (setq fldId (entget (cdr (assoc 360 field)))
              field (vl-remove (assoc 360 field) field)
              str   (strcat
                      (substr str 1 pos)
                      (if (setq objID (cdr (assoc 331 fldId)))
                        (vl-string-subst
                          (strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
                          "ObjIdx"
                          (cdr (assoc 2 fldId))
                        )
                        (foo fldId (cdr (assoc 2 fldId)))
                      )
                      (substr str (1+ (vl-string-search ">%" str pos)))
                    )
        )
      )
      str
    )
  )
  ;;--------------------------------------------------------;;
 
  (setq elst (entget ent))
  (if (and
    (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT"))
    (setq xdict (cdr (assoc 360 elst)))
    (setq dict (dictsearch xdict "ACAD_FIELD"))
    (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
      )
    (setq str (foo field (cdr (assoc 2 field))))
  )
)

;;============================================================;;

;; gc:EnameToObjectId (gile)
;; Returns the ObjectId from an ename
;;
;; Argument : an ename

(defun gc:EnameToObjectId (ename)
  ((lambda (str)
     (hex2dec
       (substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
     )
   )
    (vl-princ-to-string ename)
  )
)

;;============================================================;;

;; hex2dec (gile)
;; Converts an hexadecimal (string) to a decimal (int)
;;
;; Argument : a string figuring an hexadecimal

(defun hex2dec (s / r l n)
  (setq    r 0 l (vl-string->list (strcase s)))
  (while (setq n (car l))
    (setq l (cdr l)
          r (+ (* r 16) (- n (if (<= n 57) 48 55)))
    )
  )
)

;;============================================================;;

;; lst2str (gile)
;; Concatenates a list of strings and a separator into a string
;;
;; Arguments
;; lst : the list to convert
;; sep : the separator (string)

(defun lst2str (lst sep)
  (if (cdr lst)
    (strcat (car lst) sep (lst2str (cdr lst) sep))
    (car lst)
  )
)


KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #19 on: February 26, 2010, 04:45:53 PM »
WOW some more! It adds the fields then inserts the total in the attribute which is now a field and they all update automatically. This is some good stuff! One question I have though. In the dimFld.lsp how do I get it to display two decimal places only? For instance (rtos txtsum 2 2) converts the variable txtsum from a real to a string to two decimal places. I don't know how to do that with the dimFld.lsp.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #20 on: February 26, 2010, 04:51:36 PM »
You're welcome KOWBOI  8-)

I have added a few settings to the top of the LISP for you:

Code: [Select]
(defun c:dimFld (/ e1 e2 pt Units Prec suff)
  (vl-load-com) ;; Lee Mac  ~  26.02.10

  (setq Units 2 Prec 2 suff "sq.ft")

  (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                             (vlax-get-acad-object)))))

  (or (tblsearch "LAYER" "NO_PLOT_LAYER")
      (vla-add (vla-get-layers *doc) "NO_PLOT_LAYER"))

  (if (and (setq e1 (car (entsel "\nSelect Dimension 1: ")))
           (eq "DIMENSION" (cdr (assoc 0 (entget e1))))
           (setq e2 (car (entsel "\nSelect Dimension 2: ")))
           (eq "DIMENSION" (cdr (assoc 0 (entget e2))))
           (setq pt (getpoint "\nSelect Point for Field: ")))

    (vla-put-layer
      (vla-AddMText

        (if (zerop (vla-get-ActiveSpace *doc))
          (if (eq :vlax-true (vla-get-Mspace *doc))
            (vla-get-ModelSpace *doc)
            (vla-get-PaperSpace *doc))
          (vla-get-ModelSpace *doc)) (vlax-3D-point pt) 0.

        (strcat "%<\\AcExpr "
                "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-Objectid (vlax-ename->vla-object e1)))">%).Measurement >% * "
                "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-Objectid (vlax-ename->vla-object e2)))">%).Measurement >%"
                " \\f \"%lu" (itoa Units) "%pr" (itoa Prec) "%ps[, " suff "]%ct8[1.07639104e-005]\" >%"))
     
    "NO_PLOT_LAYER"))

  (princ))

nivuahc

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #21 on: February 26, 2010, 04:53:22 PM »
I just wanted to say, Lee, that I appreciate your work on this particular issue. It filled in a few gaps for me on a small project that I'd been considering for a few days.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #22 on: February 26, 2010, 04:55:14 PM »
You're welcome nivuahC  8-) Happy to help mate  :-)

KOWBOI

  • Guest
Re: Adding and subtracting dimensions with lisp.
« Reply #23 on: February 26, 2010, 05:19:50 PM »
This is perfect, thank you Lee. Clearly I have have much to learn.  :ugly:

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Adding and subtracting dimensions with lisp.
« Reply #24 on: February 26, 2010, 05:21:30 PM »
No worries KOWBOI - the Field codes aren't too difficult to pick up, don't worry  ;-)