Combining 2 Different LISP into One Code

[lemmanapat]

Hello, I'm using a Lisp from Lee Mac, that provide the area of the closed polyline and i want to add additional code for more efficient way to use instead of 2 lisp codes.

here are the code that im using:

 

;;----------------------------------------------------------------------;;
;; Length Field Commands                                                ;;
;;----------------------------------------------------------------------;;

(defun c:lf  ( ) (lengthfield nil  t  "%lu6"))            ;; Current units, subtraction prompt
(defun c:lfm ( ) (lengthfield nil nil "%lu6%ct8[0.001]")) ;; Current units with 0.001 conversion factor (mm->m), no subtraction prompt

;;----------------------------------------------------------------------;;
;; Area Field Commands                                                  ;;
;;----------------------------------------------------------------------;;

(defun c:af  ( ) (areafield nil  t  "%lu6%qf1"))           ;; Current units, subtraction prompt
(defun c:afm ( ) (areafield nil nil "%lu2%pr2%ct8[1.000000000000000E-006]")) ;; Current units with 1e-6 (0.0000001) conversion factor (mm2->m2), no subtraction prompt

;;----------------------------------------------------------------------;;

;;----------------------=={ Length & Area Field }==---------------------;;
;;                                                                      ;;
;;  This program offers two commands to allow a user to generate a      ;;
;;  field expression referencing either the area or the                 ;;
;;  length/perimeter/circumference of one or more selected objects.     ;;
;;  In the case of selecting multiple objects, the field expression     ;;
;;  will reference the sum of the areas or lengths of all objects in    ;;
;;  the selection.                                                      ;;
;;                                                                      ;;
;;  The user may opt to specify a point at which to create a new        ;;
;;  multiline text object housing the field expression, pick a table    ;;
;;  cell in which the field should be inserted, or select an existing   ;;
;;  single-line text, multiline text, multileader, or attribute to      ;;
;;  be populated with the field expression.                             ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'LF' (Length Field) at the AutoCAD  ;;
;;  command-line, the program first prompts the user to make a          ;;
;;  selection of objects for which to return the length summation.      ;;
;;                                                                      ;;
;;  At this prompt, the user may select any number of Arcs, Circles,    ;;
;;  Lines, 2D Polylines (light or heavy), or 3D Polylines.              ;;
;;                                                                      ;;
;;  Alternatively, upon issuing the command syntax 'AF' (Area Field)    ;;
;;  at the AutoCAD command-line, the program will prompt the user to    ;;
;;  make a selection of objects for which to return the area summation. ;;
;;                                                                      ;;
;;  At this prompt, the user may select any number of Arcs, Circles,    ;;
;;  Ellipses, Hatches, 2D Polylines (light or heavy), Regions, or       ;;
;;  Splines. If the selected object is open, the area is computed as    ;;
;;  though a straight line connects the start point and endpoint.       ;;
;;                                                                      ;;
;;  The user is then prompted to specify a point or table cell to       ;;
;;  insert a field expression referencing the summation of the lengths  ;;
;;  or areas of the selected objects.                                   ;;
;;                                                                      ;;
;;  At this prompt, the user may also choose the 'Object' option in     ;;
;;  order to populate the content of an existing annotation object      ;;
;;  with the field expression.                                          ;;
;;                                                                      ;;
;;  Upon choosing this option, the user may select any single-line      ;;
;;  text (DText), multiline text (MText), single-line or multiline      ;;
;;  attribute, attributed block, or multileader (MLeader) with either   ;;
;;  multiline text or attributed block content.                         ;;
;;                                                                      ;;
;;  If the user selects an attributed block or attributed multileader   ;;
;;  with more than one attribute, the user is presented with a dialog   ;;
;;  interface listing the available attributes, and is prompted to      ;;
;;  select a destination for the field expression.                      ;;
;;                                                                      ;;
;;  The user may optionally predefine the target block/multileader      ;;
;;  attribute by specifying the attribute tag where noted at the top    ;;
;;  of the program source code.                                         ;;
;;                                                                      ;;
;;  The resulting field expression will display the sum of the lengths  ;;
;;  or areas of the selected objects, formatted using the field         ;;
;;  formatting code specified at the top of each command definition.    ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright   2017  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2017-08-06                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2017-08-06                                      ;;
;;                                                                      ;;
;;  - Program modified to account for selection of existing annotation  ;;
;;    objects which already contain a field expression.                 ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2018-10-29                                      ;;
;;                                                                      ;;
;;  - Restructured program to use standard LM:outputtext function.      ;;
;;  - Incorporated Area Field functionality and added new 'AF' command. ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2018-11-04                                      ;;
;;                                                                      ;;
;;  - Changed 'c:lf' and 'c:af' commands to functions accepting an      ;;
;;    optional attribute tag and field formatting argument to enable    ;;
;;    the user to create multiple commands with varying parameters.     ;;
;;----------------------------------------------------------------------;;
;;  Version 1.4    -    2022-09-05                                      ;;
;;                                                                      ;;
;;  - Added optional prompt for lengths & areas to be subtracted.       ;;
;;----------------------------------------------------------------------;;

;; tag - [str] Optional target attribute tag (nil for none)
;; sub - [bol] Optional subtraction prompt (t/nil)
;; fmt - [str] Optional field formatting string (nil for none)

(defun lengthfield ( tag sub fmt / *error* ftr idx lst obj prp ss1 ss2 )
    
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (LM:startundo (LM:acdoc))
    (setq pfn
        (lambda ( obj )
            (cdr
                (assoc (vla-get-objectname obj)
                   '(
                        ("AcDbArc"        . "ArcLength")
                        ("AcDbCircle"     . "Circumference")
                        ("AcDbLine"       . "Length")
                        ("AcDbPolyline"   . "Length")
                        ("AcDb2dPolyline" . "Length")
                        ("AcDb3dPolyline" . "Length")
                    )
                )
            )
        )
    )

    (setq ftr
        (list
            (list
               '(000 . "ARC,CIRCLE,LINE,*POLYLINE")
               '(-04 . "<NOT")
                   '(-04 . "<AND")
                       '(000 . "POLYLINE") '(-04 . "&") '(070 . 80)
                   '(-04 . "AND>")
               '(-04 . "NOT>")
                (if (= 1 (getvar 'cvport))
                    (cons 410 (getvar 'ctab))
                   '(410 . "Model")
                )
            )
        )
    )

    (if (setq ss1 (LM:ssget "\nSelect objects to obtain total length <exit>: " ftr))
        (progn
            (if sub
                (if (setq ss2 (LM:ssget "\nSelect objects to subtract <skip>: " ftr))
                    (setq lst (buildfieldlist ss2 lst " - " pfn))
                )
            )
            (if (< 5 (length (setq lst (cdr (setq lst (buildfieldlist ss1 lst " + " pfn))))))
                (setq lst (append '("%<\\AcExpr ") lst '(">%")))
            )
            (if (and fmt (/= "" fmt))
                (setq lst (reverse (vl-list* "\">%" fmt " \\f \"" (cdr (reverse lst)))))
            )
            (LM:outputtext tag (apply 'strcat lst))
        )
    )
    (*error* nil) (princ)
)

;;----------------------------------------------------------------------;;

;; tag - [str] Optional target attribute tag (nil for none)
;; sub - [bol] Optional subtraction prompt (t/nil)
;; fmt - [str] Optional field formatting string (nil for none)

(defun areafield ( tag sub fmt / *error* ftr lst ss1 ss2 )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (LM:startundo (LM:acdoc))
    (setq pfn (lambda ( obj ) "Area"))
    (setq ftr
        (list
            (list
               '(000 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE")
               '(-04 . "<NOT")
                   '(-04 . "<AND")
                       '(000 . "POLYLINE") '(-04 . "&") '(070 . 88)
                   '(-04 . "AND>")
               '(-04 . "NOT>")
                (if (= 1 (getvar 'cvport))
                    (cons 410 (getvar 'ctab))
                   '(410 . "Model")
                )
            )
        )
    )

    (if (setq ss1 (LM:ssget "\nSelect objects to obtain total area <exit>: " ftr))
        (progn
            (if sub
                (if (setq ss2 (LM:ssget "\nSelect objects to subtract <skip>: " ftr))
                    (setq lst (buildfieldlist ss2 lst " - " pfn))
                )
            )
            (if (< 5 (length (setq lst (cdr (setq lst (buildfieldlist ss1 lst " + " pfn))))))
                (setq lst (append '("%<\\AcExpr ") lst '(">%")))
            )
            (if (and fmt (/= "" fmt))
                (setq lst (reverse (vl-list* "\">%" fmt " \\f \"" (cdr (reverse lst)))))
            )
            (LM:outputtext tag (apply 'strcat lst))
        )
    )
    (*error* nil) (princ)
)

(defun buildfieldlist ( sel lst opr pfn / idx )
    (repeat (setq idx (sslength sel))
        (setq idx (1- idx)
              obj (vlax-ename->vla-object (ssname sel idx))
              lst (vl-list* opr "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid obj) ">%)." (pfn obj) ">%" lst)
        )
    )
)

;; Output Text  -  Lee Mac
;; Prompts the user to specify a point at which to create an MText object containing the supplied string or to
;; select a table cell, text, mtext, multileader, attribute, or attributed block to be populated with the supplied string.
;; tag - [str] Optional target attribute tag
;; str - [str] Field expression or other text content

(defun LM:outputtext ( tag str / ent enx flg idx obj oid sel tab tmp typ )
    (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))
        )
    )
    (while
        (not
            (progn
                (if flg
                    (progn
                        (setvar 'errno 0)
                        (initget "Point eXit")
                        (setq sel (nentsel "\nSelect text, mtext, mleader, attribute or attributed block [Point/eXit] <eXit>: "))
                    )
                    (progn
                        (initget "Object eXit")
                        (setq sel (getpoint "\nSpecify point or table cell [Object/eXit] <eXit>: "))
                    )
                )
                (cond
                    (   (= 7 (getvar 'errno))
                        (prompt "\nMissed, try again.")
                    )
                    (   (or (null sel) (= "eXit" sel)))
                    (   (= "Point" sel)
                        (setq flg nil)
                    )
                    (   (= "Object" sel)
                        (not (setq flg t))
                    )
                    (   flg
                        (setq ent (car sel)
                              enx (entget ent)
                              typ (cdr (assoc 0 enx))
                              obj (vlax-ename->vla-object ent)
                        )
                        (cond
                            (   (and (= 2 (length sel)) (wcmatch typ "TEXT,MTEXT"))
                                (if (vlax-write-enabled-p obj)
                                    (LM:outputtext:puttextstring obj str)
                                    (prompt "\nThe selected text object is on a locked layer.")
                                )
                            )
                            (   (and (= "ATTRIB" typ)
                                     (/= 'str (type tag))
                                )
                                (if (vlax-write-enabled-p obj)
                                    (progn
                                        (LM:outputtext:puttextstring obj str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (LM:outputtext:updatefield ent))
                                    )
                                    (prompt "\nThe selected attribute is on a locked layer.")
                                )
                            )
                            (   (and
                                    (or
                                        (and (= "ATTRIB" typ)
                                             (setq tmp (cdr (assoc 330 enx)))
                                        )
                                        (and (setq tmp (last (cadddr sel)))
                                             (= "INSERT" (cdr (assoc 0 (entget tmp))))
                                        )
                                    )
                                    (setq tmp (vlax-invoke (vlax-ename->vla-object tmp) 'getattributes))
                                    (or
                                        (and (= 'str (type tag))
                                             (setq idx (vl-position (strcase tag) (mapcar 'vla-get-tagstring tmp)))
                                             (setq obj (nth idx tmp))
                                        )
                                        (and (not (cdr tmp))
                                             (setq obj (car tmp))
                                        )
                                        (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'vla-get-tagstring tmp) 2))
                                             (setq obj (nth (car idx) tmp))
                                        )
                                    )
                                )
                                (if (vlax-write-enabled-p obj)
                                    (progn
                                        (LM:outputtext:puttextstring obj str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (LM:outputtext:updatefield (vlax-vla-object->ename obj)))
                                    )
                                    (prompt "\nThe selected attribute is on a locked layer.")
                                )
                            )
                            (   (and (= 2 (length sel)) (= "MULTILEADER" typ))
                                (setq typ (cdr (assoc 172 (reverse enx))))
                                (cond
                                    (   (and (<= acblockcontent typ acmtextcontent) (not (vlax-write-enabled-p obj)))
                                        (prompt "\nThe selected multileader is on a locked layer.")
                                    )
                                    (   (= acmtextcontent typ)
                                        (LM:outputtext:puttextstring obj str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (vla-regen (LM:acdoc) acactiveviewport))
                                        t
                                    )
                                    (   (and
                                            (= acblockcontent typ)
                                            (setq tmp (LM:getmleaderattributes obj))
                                            (or
                                                (and (= 'str (type tag))
                                                     (setq oid (cdr (assoc (strcase tag) tmp)))
                                                )
                                                (and (not (cdr tmp))
                                                     (setq oid (cdar tmp))
                                                )
                                                (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'car tmp) 2))
                                                     (setq oid (cdr (nth (car idx) tmp)))
                                                )
                                            )
                                        )
                                        (LM:setmleaderattributevalue obj oid str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (vla-regen (LM:acdoc) acactiveviewport))
                                        t
                                    )
                                    (   (prompt "\nThe select multileader has no editable content."))
                                )
                            )
                            (   (prompt "\nThe selected object is not text, mtext, multileader, attribute or attributed block."))
                        )
                    )
                    (   (setq tmp (LM:getcell tab (trans sel 1 0)))
                        (if (vlax-write-enabled-p (car tmp))
                            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-settext (append tmp (list str)))))
                            (prompt "\nThe selected table cell belongs to a table on a locked layer.")
                        )
                    )
                    (   (vla-addmtext
                            (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                            (vlax-3D-point (trans sel 1 0))
                            0.0
                            str
                        )
                    )
                )
            )
        )
    )
)

(defun LM:outputtext:puttextstring ( obj str )
    (vla-put-textstring obj "") ;; To clear any existing field
    (vla-put-textstring obj str)
    t
)

(defun LM:outputtext:updatefield ( ent / cmd rtn )
    (setq cmd (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (setq rtn (vl-cmdf "_.updatefield" ent ""))
    (setvar 'cmdecho cmd)
    rtn
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Get MLeader Attributes  -  Lee Mac
;; Returns an association list of attribute tags & object IDs for all attributes held by an mleader block
;; mld - [vla] MLeader vla-object
;; Returns: [lst] List of ((<Attribute Tag> . <Object ID>) ... )

(defun LM:getmleaderattributes ( mld / rtn )
    (vlax-for obj (vla-item (vla-get-blocks (vla-get-document mld)) (vla-get-contentblockname mld))
        (if
            (and
                (= "AcDbAttributeDefinition" (vla-get-objectname obj))
                (= :vlax-false (vla-get-constant obj))
            )
            (setq rtn (cons (cons (strcase (vla-get-tagstring obj)) (LM:intobjectid obj)) rtn))
        )
    )
    (reverse rtn)
)

;; Object ID (integer)  -  Lee Mac
;; Returns an integer representing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:intobjectid ( obj )
    (if (vlax-property-available-p obj 'objectid32)
        (defun LM:intobjectid ( obj ) (vla-get-objectid32 obj))
        (defun LM:intobjectid ( obj ) (vla-get-objectid   obj))
    )
    (LM:intobjectid obj)
)

;; Set MLeader Attribute Value  -  Lee Mac
;; obj - [vla] MLeader vla-object
;; idx - [int] Attribute Definition Object ID
;; str - [str] Attribute value

(defun LM:setmleaderattributevalue ( obj idx str )
    (if (vlax-method-applicable-p obj 'setblockattributevalue32)
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue   obj idx str))
    )
    (LM:setmleaderattributevalue obj idx str)
)

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
 
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)

;; Get Cell  -  Lee Mac
;; 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
    )
)

;; ObjectID  -  Lee Mac
;; 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 (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; 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
    (strcat
        "\n:: LengthAreaField.lsp | Version 1.4 | \\U+00A9 Lee Mac "
        ((lambda ( y ) (if (= y (menucmd "m=$(edtime,0,yyyy)")) y (strcat y "-" (menucmd "m=$(edtime,0,yyyy)")))) "2017")
        " www.lee-mac.com ::"
        "\n:: \"LF\" for Length Field | \"AF\" for Area Field ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

I only using the "AFM" Command, and that gives me the total area of a polyline with a converted decimal places. but i also want to add another LISP code to the "AFM" command which gives me 

Total Sheet Waste, and Waste increase in cost. here's the other LISP Command i want to Merge:

 

(defun c:q1 (/ h w pa sa sw x wc)
(setq h (getreal "enter sheet dimension 1"))
(setq w (getreal "enter sheet dimension 2"))
(setq pa (getreal "enter panel area"))

(setq sa (* (* h 0.001) (* w 0.001)))

(setq sw (- 100 (/ (* pa 100) sa)))
(setq x (rtos sw 2 2))

(cond
((<= sw 7.5) (setq wc 5.26))
((<= sw 12.5) (setq wc 11.11))
((<= sw 17.50) (setq wc 17.65))
((<= sw 22.5) (setq wc 25))
((<= sw 27.5) (setq wc 33.33))
((<= sw 32.5) (setq wc 42.86))
((<= sw 37.5) (setq wc 53.85))
((<= sw 42.5) (setq wc 66.67))
((<= sw 47.5) (setq wc 81.82))
(t (setq wc 100))
)

(command "mtext" (setq pt1 (getpoint "\nSelect Point: ")) (getcorner pt1 "\nSelect Other point:") pa x wc "")
)

 

is there any way that we can combine these 2 LISP into 1 Command?

 

there's also a prompt that the code ask the user for the panel width and length. is there any way the code will get the width and length data to specific table so that i wont need to input the length and width manually?, if its not possible then im okay with manual input of it. 

 

I hope anyone can help. 

Cheers

 

 

Here's the sample if AFM command i used in Area Table (A2 Cell)

[fuccaro]

Here's my try:

(defun c:pp()
  (setq area (vla-get-area (vlax-ename->vla-object (car (entsel "select polyline")))))
  (setq unit (getvar "INSUNITS"))
  (setq mult (+ (* (- 2 unit) (- unit 5)) 4))
  (setq areaU (/ area (expt 10 mult)))
  (strcat (rtos areaU) " m2")

  (setq h (getreal "enter sheet dimension 1"))
  (setq w (getreal "enter sheet dimension 2"))
  ;(setq pa (getreal "enter panel area"))
  (setq pa areaU)
  (setq sa (* (* h 0.001) (* w 0.001)))
  (setq sw (- 100 (/ (* pa 100) sa)))
  (setq x (rtos sw 2 2))
  (cond
    ((<= sw 7.5) (setq wc 5.26))
    ((<= sw 12.5) (setq wc 11.11))
    ((<= sw 17.50) (setq wc 17.65))
    ((<= sw 22.5) (setq wc 25))
    ((<= sw 27.5) (setq wc 33.33))
    ((<= sw 32.5) (setq wc 42.86))
    ((<= sw 37.5) (setq wc 53.85))
    ((<= sw 42.5) (setq wc 66.67))
    ((<= sw 47.5) (setq wc 81.82))
    (t (setq wc 100))
    )
  (command "mtext" (setq pt1 (getpoint "\nSelect Point: ")) (getcorner pt1 "\nSelect Other point:") pa x wc "")
  )

I wrote a simple lisp that returns the area of a polyline. If the drawing units are mm, cm, m or Km, the program returns the area in square meters. For other units, it will return garbage!

The second lisp suggests that your units are mm, if that' always the case, the lisp could be even simpler.

I don't understand how would you like to enter the sheet's dimensions - sorry, my English is far from good.

[lemmanapat]

10 hours ago, fuccaro said:

Here's my try:

(defun c:pp()
  (setq area (vla-get-area (vlax-ename->vla-object (car (entsel "select polyline")))))
  (setq unit (getvar "INSUNITS"))
  (setq mult (+ (* (- 2 unit) (- unit 5)) 4))
  (setq areaU (/ area (expt 10 mult)))
  (strcat (rtos areaU) " m2")

  (setq h (getreal "enter sheet dimension 1"))
  (setq w (getreal "enter sheet dimension 2"))
  ;(setq pa (getreal "enter panel area"))
  (setq pa areaU)
  (setq sa (* (* h 0.001) (* w 0.001)))
  (setq sw (- 100 (/ (* pa 100) sa)))
  (setq x (rtos sw 2 2))
  (cond
    ((<= sw 7.5) (setq wc 5.26))
    ((<= sw 12.5) (setq wc 11.11))
    ((<= sw 17.50) (setq wc 17.65))
    ((<= sw 22.5) (setq wc 25))
    ((<= sw 27.5) (setq wc 33.33))
    ((<= sw 32.5) (setq wc 42.86))
    ((<= sw 37.5) (setq wc 53.85))
    ((<= sw 42.5) (setq wc 66.67))
    ((<= sw 47.5) (setq wc 81.82))
    (t (setq wc 100))
    )
  (command "mtext" (setq pt1 (getpoint "\nSelect Point: ")) (getcorner pt1 "\nSelect Other point:") pa x wc "")
  )

I wrote a simple lisp that returns the area of a polyline. If the drawing units are mm, cm, m or Km, the program returns the area in square meters. For other units, it will return garbage!

The second lisp suggests that your units are mm, if that' always the case, the lisp could be even simpler.

I don't understand how would you like to enter the sheet's dimensions - sorry, my English is far from good.

 

Your LISP code works great! however, can we modify the part where the user select the polyline into multiple? if there's the case i have more than one polyline to be selected like the first LISP code. Also can we make it Field type like the first Code? thank you!

[BIGAL]

A couple of suggestions, in a table can use a field, so I would use the  2 dimensions of the panel for length & width as fields in the table, like wise the area in the table can be a field formula of length x width, the advantage here is if you cheat and edit the dim and not the rectang, the true area is reflected.

 

Have a look at my Multi getvals a dcl for inputs, there is sample code in the top of the lisp.  Multi GETVALS.lsp

 

Mtext supports pt pt so dont need to pick 2 points, just one.

 

Add a panel ID to code.

 

The table

Panel-ID  Area Length Width Waste Wcost

 

 

 

Edited February 19 by BIGAL

[lemmanapat]

23 hours ago, BIGAL said:

A couple of suggestions, in a table can use a field, so I would use the  2 dimensions of the panel for length & width as fields in the table, like wise the area in the table can be a field formula of length x width, the advantage here is if you cheat and edit the dim and not the rectang, the true area is reflected.

 

Have a look at my Multi getvals a dcl for inputs, there is sample code in the top of the lisp.  Multi GETVALS.lsp

 

Mtext supports pt pt so dont need to pick 2 points, just one.

 

Add a panel ID to code.

 

The table

Panel-ID  Area Length Width Waste Wcost

 

 

 

Thanks for suggestions!, may you please elaborate more? i have little to no experience in LISP and asking for your patience to explain briefly so i can understand the codes. thank you so much! 

[BIGAL]

 

For me I would have a front end that draws the rectangs, does the dimensions and makes a table.

(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter values " "Length " 5 4 "1000" "Width " 5 4 "750" )))

 

 

Post a proper sample dwg. Including a table.

Edited February 21 by BIGAL

[lemmanapat]

Here are the sample DWG file. if you'll see, i want to make the lisp command to select multiple polyline, total the sqm of the multiple polyline, and calculate the sheet waste automatically, no needing for the user input of the sheet length and width. if that's possible, the lisp can get the value on the specific table indicating the lenght and width

sample lisp combination.dwg

[BIGAL]

There is maybe a quick easy way to fill in all the information, both in block and in the table.

 

You can use Bpoly to make plines that represent your objects so you get based on sample dwg 4 rectangs. Can sort based on size re the outer box. Then get lengths and widths etc. The only thing I had to do was turn off the Cyan layer. 4_-_T4 4_76_FINAL_PASS_OFFSET, try it with bpoly pick a point inside big box.

 

I have one question then code will work is why does left hand bottom corner have a cutout as does add an extra step in sheet size calcs, can it be on another layer ?

 

 

 

Watch this space.

 

 

 

Edited February 21 by BIGAL

[lemmanapat]

Hi, The box in the bottom left corner represents the CNC tool starting point. so by preset, we leave it open for the machine.