05-28-2016
09:03 AM
- Marcar como nuevo
- Favorito
- Suscribir
- Silenciar
- Suscribirse a un feed RSS
- Resaltar
- Imprimir
- Denunciar
05-28-2016
09:03 AM
@Anonymous wrote:
I have a drawing with many hatches. I need the area of each hatch in the drawing. I used FIELD command, it works but is slow with many hatches. Does AutoCAD have a feature to label more objects with one command?
You can try these routines. The first makes area as a field, the second as a text.
Text is placed in the middle of shape, but be careful about specific shapes such as "U" shape, where the middle point is NOT laying inside of shape.
Spoiler
(vl-load-com)
(defun c:HatchArea2Field (/ asp adoc ss en ptsum ptlst ID field obj pt)
(setq asp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
(vla-startundomark adoc)
(if (setq ss (ssget ":L" '((0 . "HATCH") (410 . "Model"))))
(repeat (sslength ss)
(setq en (ssname ss 0)
ptsum '(0 0)
ptlst (cdr (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))))
novrt (length ptlst)
ID (itoa (vla-get-objectid (vlax-ename->vla-object en)))
field (strcat "%<\\AcObjProp Object(%<\\_ObjId " ID ">%).Area \\f \"%lu2\">%"))
(foreach x ptlst (setq ptsum (mapcar '+ x ptsum)))
(vla-put-AttachmentPoint
(setq obj (vla-addMText asp (setq pt (vlax-3d-point (mapcar '/ ptsum (list novrt novrt)))) 0 field))
acAttachmentPointMiddleCenter)
(vla-put-InsertionPoint obj pt)
(ssdel en ss)
)
(princ "\nNo object found."))
(vla-endundomark adoc)
(princ)
)
(defun c:HatchArea2Text (/ asp adoc ss en ptsum ptlst ID area obj pt)
(setq asp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
(vla-startundomark adoc)
(if (setq ss (ssget ":L" '((0 . "HATCH") (410 . "Model"))))
(repeat (sslength ss)
(setq en (ssname ss 0)
area (rtos (vla-get-area (vlax-ename->vla-object en)) 2)
ptsum '(0 0)
ptlst (cdr (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))))
novrt (length ptlst))
(foreach x ptlst (setq ptsum (mapcar '+ x ptsum)))
(vla-put-AttachmentPoint
(setq obj (vla-addMText asp (setq pt (vlax-3d-point (mapcar '/ ptsum (list novrt novrt)))) 0 area))
acAttachmentPointMiddleCenter)
(vla-put-InsertionPoint obj pt)
(ssdel en ss)
)
(princ "\nNo object found."))
(vla-endundomark adoc)
(princ)
)