Anuncios

The Autodesk Community Forums has a new look. Read more about what's changed on the Community Announcements board.

ВeekeeCZ
en respuesta a: Anonymous


@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)
)