Calculate Area by picking internal point

[bbb120]

who can help me modify the code of Lee Mac ?

[LEsq]

who can help me modify the code of Lee Mac ?

 

>>novice about LISP language ,I just learn it from today

 

 

For what I read, you need to go one step at the time, don't force yourself to try to solve something that you don't have any experience.

 

Give yourself time, and spend it learning - do trial and error any technique that could help.

 

And start from simple task, until you become familiar with the language.

 

Unless someone here have the time and will be willing to provide a full solution.

 

My 0.02 cts.

 

BTW, don't see any use of the undocumented autolisp functions:

bpoly and bhatch - as better alternatives from the command boundary version

[Cad64]

who can help me modify the code of Lee Mac ?

 

If you want to continue receiving help with this, or any other questions you may have in the future, you might want to try saying "Thank you" every once in a while. Just a friendly suggestion. :wink:

[alanjt]

If one is inclined to use that garbage I posted so long ago, I would hope they have the sense to spend the required time on doing it right. I quit using that routine long ago, so I never had a reason to improve upon it.

 

Nice work BTW, Lee.

 

From my link, this code should put the area of a polyline into an Excel cell, so, with a combination of this and Alan's LISP, you should get your desired result:

 

;; Area to Excel Cell  ~  Lee McDonnell (Lee Mac)
;; Copyright © August 2009

(defun c:A2xl (/ *error* xlApp xlCells Row)
 (vl-load-com)

 (defun *error* (msg)
   (ObjRel (list xlApp xlCells))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq xlApp  (vlax-get-or-create-object "Excel.Application")
       xlCells   (vlax-get-property
                   (vlax-get-property
                     (vlax-get-property
                       (vlax-invoke-method
                         (vlax-get-property xlApp 'Workbooks)
                         'Add)
                       'Sheets)
                     'Item 1)
                   'Cells)    Row 1)

 (while
   (and
     (setq ent (car (entsel "\nSelect Object: ")))
       (vlax-property-available-p
         (setq Obj
           (vlax-ename->vla-object ent)) 'Area))

   (vlax-put-property xlCells 'Item row 1
     (rtos
       (vlax-get-property Obj 'Area)))
   
   (setq Row (1+ Row)))

 (ObjRel (list xlApp xlCells))
 (gc) (gc)
 (princ))
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))

[Lee Mac]

Thanks AJ But as usual, its the thread of never-ending requests...

[alanjt]

Thanks AJ But as usual, its the thread of never-ending requests...

 

Of course, one door opens 50.

 

[We need a smiley that shakes his head.]

[Lee Mac]

[We need a smiley that shakes his head.]

 

Or facepalms...

[sachindkini]

dear

 

see atthed file

pline-area.lsp

[alanjt]

Or facepalms...

HaHa That works.

[Sooshiant]

in addition to calculating the acreage based on a picked point (doesn't have to be a polyline) and placing mtext at your picked point, you can increment your labels (ie: Lot 1, and then it will just increase by 1. i wrote this for when i design subdivisions and when i've laid my lots out i can just quickly pick and label them.

 

;CREATED BY: alan thompson 11.28.07
;MODIFIED BY: alan thompson 12.19.07 (mtext instead of dtext, lot numbering works better, etc.)
(defun c:GA()
(setq DZIN (getvar "dimzin"))
(setq des (getstring "\Enter Number Prefix (Lot, Parcel, etc.): "))
(setq ins 1)
(setq n (getint "\Enter First Lot Number: "))
(while
(setq ins (getpoint "\nPick Number Location: "))
(command "dimzin" "0")
(command "-boundary" ins "")
(command "area" "o" "l")
(command "erase" "l" "")
(setq AR (getvar "area"))
(setq ACRE (strcat (rtos (/ (getvar "area") 43560) 2 2) " AC.±"))
(setq txt (strcat des " " (rtos n 2 0)))
(command "mtext" ins "j" "mc" ins txt ACRE "")
(setq n (1+ n))
(command "dimzin" DZIN)
(princ "\n")(princ ACRE)(princ " & ")(princ (getvar "area"))(princ" SQ. FT.")
);WHILE
(princ))

 

Is there any way to change this code as not to be related to drawing units and eliminate other unnecessary annoying prefixes and suffixes and just write a number?

Thanks

[Sooshiant]

??????????????

[BIGAL]

Its called Notepad amend code. Remove what you dont want. Look at Strcat

[3dwannab]

I quickly modified the code from Alan to work in decimal units and output the result in meters squared.

 

; CREATED BY: alan thompson 11.28.07
; MODIFIED BY: alan thompson 12.19.07 (MTEXT instead of DTEXT, lot numbering works better, etc.)
; MODIFIED BY: 3dwannab 18.01.22
;   Just modified slightly to work with decimals as units.
;   Asks user for the height of the MTEXT.
;   Outputs '95.78m²' to the MTEXT object and 'Area in m²: 95.78' to the command line.

(defun c:Area_Get_Picked( /
                          *error*
                          areacmdstr
                          areainmmval
                          mtextcontents
                          pt
                          )

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
         )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
    )

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_osmode (getvar "osmode"))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (graphscr)
  (setq pt (getpoint "Click internal point: "))
  (command "-hatch" pt "")
  (command "area" "o" "L")
  (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718
  (setq areacmdstr (strcat "\n\nArea in m\U+00B2: " areainmmval))
  (command "erase" "L" "")
  (setq mtextcontents (strcat areainmmval "m\U+00B2"))
  (princ (strcat areacmdstr))
  (command "._MTEXT" pt "_J" "_MC" "C" "N" "H" pause pt mtextcontents "")
  (setvar "cmdecho" 1)

  (setvar 'cmdecho var_cmdecho)
  (setvar 'osmode var_osmode)

  (*error* nil) (princ)

  )

 

Edited January 18, 2022 by 3dwannab