TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: HasanCAD on May 06, 2013, 03:57:16 PM
-
I am tring tp get hatch area using
(setq obj (vlax-ename->vla-object (ssname sset cnt)))
(setq ar (+ ar (vla-get-area obj)))
but gives error
Select objects: ; error: Automation Error. Invalid input
-
http://www.theswamp.org/index.php?topic=32571.0
-
Check for self-intersecting hatch boundary.
-
Yes the problem I have often with unclosed, arc or Polylines with dubbel lines (Intersection in Polyline). That why I have a routine which check first if Polyline have a area value, if not it draws a line to them.
(if (= T (vl-catch-all-error-p (setq A (vl-catch-all-apply 'vla-get-area (list Vobj)))))
(progn
(princ (strcat "\nwrong area " (cdr (assoc 8 (entget ent))) ))
(setq l (cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget ent))))
(entmakex
(list
'(0 . "LINE")
(cons 10 '(0 0 0))
(cons 11 (list (cadr (nth 1 l)) (caddr (nth 1 l))))
'(62 . 256)
(assoc 8 (entget ent))
)
)
-
Some minor points Dirk, but the following may help with your understanding of AutoLISP:
The '=' function is redundant since it will return T if the vl-catch-all-error-p expression being compared returns T; hence the above is equivalent to:
Note that:
(cons 10 '
(0 0 0)) == '
(10 0 0 0) == (list 10 0 0 0)
The above could be written:
Incorporating these and some other changes:
'(0 . "LINE")
'(10 0.0 0.0 0.0)
'(62 . 256)
)
)
)
)
-
http://www.theswamp.org/index.php?topic=32571.0
Alan. Regarding that other thread - do you remember if the hatch was made using a pick-point or through selecting the polyline(s)? If the former it might have picked up some strange stuff from OFF layers (or I've even seen it pick up lines outside the boundary).
But why it would have an area on one PC but not the other on the same DWG on the same hatch is beyond comprehension. Is acad using some form of GPU acceleration to calculate the areas?
Other than that as Lee and Dirk's stated: Either it's self-intersecting (like a bow-tie) or it's not fully enclosed (e.g. using gap tolerances). In my experience these are 99.9999% of the time the culprits for non-areas.
-
http://www.theswamp.org/index.php?topic=32571.0
Alan. Regarding that other thread - do you remember if the hatch was made using a pick-point or through selecting the polyline(s)? If the former it might have picked up some strange stuff from OFF layers (or I've even seen it pick up lines outside the boundary).
But why it would have an area on one PC but not the other on the same DWG on the same hatch is beyond comprehension. Is acad using some form of GPU acceleration to calculate the areas?
Other than that as Lee and Dirk's stated: Either it's self-intersecting (like a bow-tie) or it's not fully enclosed (e.g. using gap tolerances). In my experience these are 99.9999% of the time the culprits for non-areas.
Honestly, I don't remember. I didn't create the hatches, another user had and has posted about them. It started with me posting a hatch area LISP, but I guess that thread was removed.
What you are saying, in agreement with Lee, makes sense.
-
Thanks Lee, I´m alway open for correcction. :-o
-
Thanks Lee, I´m alway open for correcction. :-o
Me too :wink:
-
is this good solution
(defun c:HatchAreas (/ AREA CNT OBJ OBJVL ORC SSET )
(defun NLayer (Nme)
(if (not (tblsearch "LAYER" Nme))
(progn
(entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord") (cons 2 Nme)
(cons 70 0) (cons 62 1))))))
(nlayer "HatchHasNoArea")
(if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)
(progn
(prompt "\nSelect hatches: ")
(if (and (setq sset (ssget '((0 . "hatch"))) cnt 0 area 0))
(progn
(repeat (sslength sset)
(setq obj (ssname sset cnt))
(setq objvl (vlax-ename->vla-object obj))
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-get-area (list objvl)))
(progn
(vla-put-color objvl 256)
(vla-put-layer objvl "HatchHasNoArea")
) ;prgn
(setq area (+ area (vla-get-area objvl)))
) ;if
(setq cnt (1+ cnt))
) ; repeat
)
) ;if
)) ; if
(alert
(strcat
"\nTotal area = "
(if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
(strcat (rtos area 2) " sq. in. (" (rtos (/ area 144) 2) " sq. ft.)"
"\nHatchs with RED color DID NOT calculated")
(strcat (rtos area) "\nHatchs with RED color DID NOT calculated"))
) ; strcat
) ;alert
) ; defun