Topic: How to get area?

[litss]

if you're going to select the lines one by one anyway, you might as well pick a point rather than select the lines:

Well, reasons:
1) the drawings are not as neat as this sample. Other lines, texts, dims, ect..will cross the figure. If pick points to "region", I need to "layer-off" those unrelavant layers, after that, "layer-on". Not that convenient as "ssget" with filters.
2) there might be some small gaps between lines' intersections. I can use the (inters ... nil) to negelect those gaps by allowing some distance errors. While the "region" will fails.
3) Actually, by apply the (command "pedit" ...), I now can achive the area. But I am still curious about the way without "command", like the Lee's Pointarea. That would be nice:)

Hope this can help ur undersanding.

I am trying a method to rearrange the intersections that collected by ur code :

(setq pts_ (cons (list (cdr (assoc 10 ent))
                     (cdr (assoc 11 ent))) pts_)))

That is:
select an arbitrary line -> (setq ptlst (list p0 p1)) -> use p0 to search for the next line (p0, p2) -> (cons p2 ptlst) -> use p2 to search for next (p2,p3).......
Maybe it would work

Thank you!

[litss]

To irneb : Thanks    Hatch is somewhat like region. Both might be fragile to gaps.
               

[hare14]

Hi

Get Volume and area from solid!

I used this code in MDT8 which worked fine.
Now on Win7 and MDT9(64bit) only the dvb-version works, this Lisp code gives an error ...access violation!

Any ideas?

Code: [Select]

(defun c:t1 (/)
  (vl-load-com)

;;;  dvb working in MDT9

;;;    Dim tmpObj As AcadObject
;;;    Dim objEntity
;;;    Set objEntity = pickObj("select 3D Solid")  ' an acad Solid Object
;;;   
;;;    Dim mcad As McadApplication
;;;    Set mcad = ThisDrawing.Application.GetInterfaceObject("Mcad.Application")
;;;    Dim mcC As IMcadBody
;;;   
;;;    Set mcC = mcad.ActiveDocument.Utility.GetObjectFromID(objEntity.ObjectID, mcSolid) ' mcC ist das mcad Solid ( mcSolid = 24 )
;;;   
;;;    Dim dArea As Double
;;;    Dim dVolume As Double
;;;
;;;   mcC.BRepEntity.Body.GetVolume dVolume ' getVolume ist eine Methode und liefert in dVolume den Wert zurück
;;;   mcC.BRepEntity.Body.GetSurfaceArea dArea


  (setq aobj (vlax-get-acad-object))
  (setq aAcDoc (vla-get-activedocument aobj))

  (setq aUtil (vla-get-utility aAcDoc))
 
  (setq mobj (vla-getinterfaceobject aobj "Mcad.Application"))
  (setq activeDoc (vla-get-activedocument mobj))
  (setq util (vla-get-utility activedoc))

  (setq Solid3d (entsel "\nSelect object "))
;;; Solid3d is an autocad-object!
 
(setq mc_solid nil)
(setq objS (vlax-ename->vla-object ( car Solid3d)))
 
(setq objId (vlax-get-property objS  'ObjectId))

(setq mc_solid (vlax-invoke-method util 'GetObjectFromid (vlax-get-property objS  'ObjectId) 0 nil nil nil nil))
 ;;;  GetObjectFromID(Id As LONG_PTR, Type As McadObjectType, [Infer As Boolean = True], [SubentType], [SubentIndex], [Point]) As IMcadObject
 ;;;                                  pars : McadObjectType = 0 , optional

 ;;; now mc_solid is an MCad-object!
   
(setq b_rep    ( vlax-get-property mc_solid 'BrepEntity ))
(setq b_body   ( vlax-get-property b_rep 'body))
(setq vol (vlax-make-variant 0 vlax-vbDouble )) 
(setq area (vlax-make-variant 0 vlax-vbDouble ))
(setq edge (vlax-make-variant 0 vlax-vbDouble ))

;;; needs a suitable tolerance !!!!
(setq tol (vlax-make-variant 0.01 vlax-vbDouble )) 

( vlax-invoke-method b_body 'getVolume 'vol tol)
( vlax-invoke-method b_body 'getSurfaceArea 'area tol)
( vlax-invoke-method b_body 'getPerimeterLength 'edge tol)

;;;  if many calls -> best practice: realease them
 (vlax-release-object b_body)
 (vlax-release-object b_rep)
 (vlax-release-object mc_solid)

 ( princ  vol )
(  princ  "  " )
(  princ  area )
(  princ  "  " )
(  princ  edge )
(  princ  "\n" ) 
)

Thanks

[irneb]

Actually the hatch may help with lines not intersecting properly (note the Gap Tolerance). Although the artifacts I was referring to is when selecting the lines (instead of pick-point) then you get strange pieces of the hatch going outside the area, see the attached.

Have you perhaps thought of using a lisp routine which asks for the pick-point, then turn off the layers or using LayIso then issuing the Boundary command and sending that point, then turning the layers back on (or LayUnIso)? That might work if the layers are always the same ones for your boundary lines.

[irneb]

What about this?

Code: [Select]

(vl-load-com)

(defun c:MyBoundary (/ pt elast layers hpgap layers-off layers-on)
  (setq hpgap (getvar 'HPGAPTOL))
  (setvar 'HPGAPTOL 50.0) ;Change to your preference
  (setq layers (cons (strcat (getvar 'CLayer)) '("0" "DIMS"))) ;Change to suit your situation, keep upper case
  (or *vla-AcadObject* (setq *vla-AcadObject* (vlax-get-acad-object)))
  (or *vla-ActiveDocument* (setq *vla-ActiveDocument* (vla-get-ActiveDocument *vla-AcadObject*)))
  (or *vla-LayersCollection* (setq *vla-LayersCollection* (vla-get-Layers *vla-ActiveDocument*)))
  (if (setq pt (getpoint "\nPick internal point of boundary: "))
    (progn
      (vlax-for layer *vla-LayersCollection*
        (if (= (vla-get-LayerOn layer) :vlax-true)
          (setq layers-on (cons layer layers-on))
          (setq layers-off (cons layer layers-off))
        )
        (vla-put-LayerOn
          layer
          (if (member (strcase (vla-get-Name layer)) layers)
            :vlax-true
            :vlax-false
          )
        )
      )
      (setq elast (entlast))
      (command "._-HATCH" "_Properties" "Solid" "_None" pt "")
      (if (eq elast (entlast))
        (princ "\nThe boundary couldn't be created.")
        (progn
          (setq elast (entlast))
          (command "._HATCHEDIT" elast "_Boundary" "_Region" "_Yes")
          (setq *boundary* nil)
          (if (eq elast (entlast))
            (princ "\nThe boundary couldn't be created.")
            (progn
              (setq *boundary* (entlast))
              (princ "\nThe boundary is created.")
            )
          )
          (entdel elast)
        )
      )
      (foreach layer layers-on
        (vla-put-LayerOn layer :vlax-true)
      )
      (foreach layer layers-off
        (vla-put-LayerOn layer :vlax-false)
      )
    )
  )
  (setvar 'HPGAPTOL hpgap)
  (princ)
)

[pBe]

Well, reasons:
1) the drawings are not as neat as this sample. Other lines, texts, dims, ect..will cross the figure. If pick points to "region", I need to "layer-off" those unrelavant layers, after that, "layer-on". Not that convenient as "ssget" with filters.
2) there might be some small gaps between lines' intersections. I can use the (inters ... nil) to negelect those gaps by allowing some distance errors. While the "region" will fails.
3) Actually, by apply the (command "pedit" ...), I now can achive the area. But I am still curious about the way without "command", like the Lee's Pointarea. That would be nice:)

If I understand it right, you cant do a "point" method because there are too many lines intersecting inside the target area.
and you would rather select lines one by one sans layer?

try this:

Code: [Select]

(defun c:Test2 ( / ss entV pts x1 x2 y1 y2 Pt2Pt PeriM Area str)
(vl-load-com)
(foreach nm '("entV" "Pt2Pt" "PeriM")
  (if (not (eval (read nm)))
    (set (setq ss (read nm)) nil)
  )
)
 (if (setq ss (ssget '((0 . "LINE"))))
  (progn
(repeat (sslength ss)
(setq entV (cons (vlax-ename->vla-object (ssname ss 0)) entV) )
(ssdel (ssname ss 0) ss)
  )
(setq pts
       (mapcar '(lambda (o k)
  (vlax-invoke o 'Intersectwith k acExtendNone)
)
       entv
       (cdr (append entv (list (car entv))))
       )
      pts (cons (last pts) pts)
)
(repeat (length entV)
                         (setq x1 (car (car pts))
                               x2 (cadr (car pts))
                               y1 (car (cadr pts))
                               y2 (cadr (cadr pts))
                               )
                         (setq Pt2Pt
                                    (cons (- (* x1 y2) (* x2 y1))
                                          Pt2Pt))
                         (setq PeriM (cons (distance (car pts)(cadr pts)) PeriM))
                         (setq pts (cdr pts))
                         )
                   (setq Area (abs (/ (apply '+ Pt2pt) 2))
                         str
                              (if (or (= (getvar "lunits") 3)
                                      (= (getvar "lunits") 4))
                                    (strcat
                                          (rtos (/ area 144) 2)
                                          " sq. ft.")
                                    (strcat (rtos Area 2) " m²")
                                    )
                         )(print Str)
  )
  )
(print)                   
  )
the code is messy right now, but we can do a cleanup later on,
You need to selct lines one by one in order <clockwise or cclockwise> as long as its the same direction

[litss]

irneb, pBe, thank you!

Quite busy these days. I'll try ur codes and finish mine after that.