area to attribute in lisp

the_ameral · ‎06-22-2021

i have edit this lisp and i hope some help to get the area link the hatch that make area in the block attribut change when change the hatch area after insertaion

this the code

(defun c:fool ( / sset ent obj minPt maxPt p1 p2 midPt)
      (setq fmt "%lu6%qf1" ;; Field Formatting
          tag nil        ;; Optional predefined attribute tag
    )
    
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
  (setq sset (ssget '((0 . "HATCH"))) i 0)
  ;(0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE")
  (repeat (sslength sset)
    (setq ent (ssname sset i))
    (setq obj (vlax-ename->vla-object ent))
    (vla-getboundingbox obj 'minPt 'maxPt)
   (setq areass (vla-get-area obj))
    (setq LAYERNAME (vla-get-layer obj))
    (setq p1 (vlax-safeArray->list minPt))
    (setq p2 (vlax-safeArray->list maxPt))
    (setq midPt (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2))
    (setq areas (rtos areass))

    
    (cond ( (/= (getvar 'attdia) 0)                 ;sets attdia to 0 if not 0
          (setq atd (getvar 'attdia))
          (setvar 'attdia 0)
        )
  );end_cond
  
  (cond ( (/= (getvar 'attreq) 1)                 ;sets attreq to 1 if not 1
          (setq atq (getvar 'attreq))
          (setvar 'attreq 1)
        )
  );end_cond

    
       (command "_-insert" "myblock" midPt 1 1 0 LAYERNAME areas aread 88)

    ;(entmakex (list (cons 0 "CIRCLE")(cons 62 1)(cons 10 midPt)(cons 8 LAYERNAME)(cons 40 (* (getvar "viewsize") 0.03))))
    (setq i (1+ i))
  )  
  (princ)


  
)

i read some thing like that but i cant get it in my edit lisp

  (vl-load-com)

  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        spc (vlax-get doc (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)))

  (while (setq ent obj)

    (if (vlax-property-available-p (setq obj0 (vlax-ename->vla-object ent)) 'Area)
(setq aread
            (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID obj0)) ">%).Area \\f \"%lu2%pr2\">%"))

the_ameral · ‎06-23-2021

any help

pbejse · ‎06-23-2021

@the_ameral wrote:

any help

Post a drawing sample to show intent, it's easier that way.

the_ameral · ‎06-23-2021

I ATTACHED LSP I USE AND DWG

"THE LISP INSERT TAG WITH SELECT HATCH AREA"

THE PROPLEM WHEN I EDIT THE HATCH "STRACH AREA"

THE AREA IN THE TAG DOESNT CHANGE

@pbejse

ronjonp · ‎06-23-2021

Try this:

(defun c:foo (/ b mp o p1 p2 s sp)
  ;; RJP » 2021-06-23
  (cond	((null (tblobjname "block" "myblock")) (alert "'MYBLOCK' not found!"))
	((setq s (ssget '((0 . "HATCH"))))
	 ;; Get current space
	 (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))
	 (foreach h (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   ;; If we have an area ( some hatches don't have an area and will display '####'
	   (if (vlax-property-available-p (setq o (vlax-ename->vla-object h)) 'area)
	     (progn ;; Get the bounding box
		    (vla-getboundingbox (setq o (vlax-ename->vla-object h)) 'p1 'p2)
		    ;; Set arrays to point list
		    (mapcar 'set '(p1 p2) (mapcar 'vlax-safearray->list (list p1 p2)))
		    ;; Get the midpoint of the bounding box
		    (setq mp (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
		    ;; Insert a block at the midpoint
		    (setq b (vla-insertblock sp (vlax-3d-point mp) "myblock" 1 1 1 0))
		    ;; Fill in 'TAG3' att with field
		    (setpropertyvalue
		      (vlax-vla-object->ename b)
		      "TAG3"
		      (strcat "%<\\AcObjProp Object(%<\\_ObjId "
			      (itoa (vla-get-objectid o))
			      ">%).Area \\f \"%lu2%pr2\">%"
		      )
		    )
	     )
	   )
	 )
	)
  )
  (princ)
)

the_ameral · ‎06-23-2021

it work very well thank u

ronjonp · ‎06-23-2021

@the_ameral wrote:

it work very well thank u

Glad to help 🍻

kidznok · ‎09-09-2023

Hi,
Is it possible to change this lisp to using with polyline not only with hatch?
Thank you very much.
All best

ronjonp · ‎09-09-2023

@the_ameral Sure.

;; Change this
(setq s (ssget '((0 . "HATCH"))))
;; To this
(setq s (ssget '((0 . "HATCH,LWPOLYLINE"))))

kidznok · ‎09-09-2023

Thank you. I changed this and have error
; error: ActiveX server returned error: unknown name: InsertBlock

ronjonp · ‎09-09-2023

@kidznok

;; Change this
(setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))
;; To this
(setq sp (vlax-ename->vla-object (cdr (assoc 330 (reverse (entget (ssname s 0)))))))

kidznok · ‎09-09-2023

Thank you very much for you help 🙂
btw Now it's works only for polyline.
Thank you, my workflow will be smarter 😉
All best

kidznok · ‎09-11-2023

Hi,
I'm sorry but could You help me once again 😉 ?
In BricsCad I have sth like this and I have block with right place without field with area.

----- Error around expression -----

; (SETPROPERTYVALUE (VLAX-VLA-OBJECT->ENAME B) "TAG3" (STRCAT "%<\\AcObjProp Object(%<\\_ObjId " (ITOA (VLA-GET-OBJECTID O)) ">%).Area \\f \"%lu2%pr2\">%"))

; in file :

; N:\Pracownia Drogowa\ZD4\!!_ISO\LABORATORIUM\Lispy\gotowe\BWA - blok z polem.lsp

;

; error : no function definition <SETPROPERTYVALUE> ; expected FUNCTION at [eval]

ronjonp · ‎09-11-2023

@kidznok Try this version. Unfortunately Bricscad does not have those get/setproperty functions available.

(defun c:foo (/ b mp o p1 p2 s sp)
  ;; RJP » 2021-06-23
  (cond	((null (tblobjname "block" "myblock")) (alert "'MYBLOCK' not found!"))
	((setq s (ssget '((0 . "HATCH"))))
	 ;; Get current space
	 (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))
	 (foreach h (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   ;; If we have an area ( some hatches don't have an area and will display '####'
	   (if (vlax-property-available-p (setq o (vlax-ename->vla-object h)) 'area)
	     (progn ;; Get the bounding box
		    (vla-getboundingbox (setq o (vlax-ename->vla-object h)) 'p1 'p2)
		    ;; Set arrays to point list
		    (mapcar 'set '(p1 p2) (mapcar 'vlax-safearray->list (list p1 p2)))
		    ;; Get the midpoint of the bounding box
		    (setq mp (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
		    ;; Insert a block at the midpoint
		    (setq b (vla-insertblock sp (vlax-3d-point mp) "myblock" 1 1 1 0))
		    ;; Fill in 'TAG3' att with field
;;;		    (setpropertyvalue
;;;		      (vlax-vla-object->ename b)
;;;		      "TAG3"
;;;		      (strcat "%<\\AcObjProp Object(%<\\_ObjId "
;;;			      (itoa (vla-get-objectid o))
;;;			      ">%).Area \\f \"%lu2%pr2\">%"
;;;		      )
;;;		    )
		    ;; For Bricscad
		    (vl-some '(lambda (att)
				(and (= "TAG3" (vla-get-tagstring att))
				     (vla-put-textstring
				       att
				       (strcat "%<\\AcObjProp Object(%<\\_ObjId "
					       (itoa (vla-get-objectid o))
					       ">%).Area \\f \"%lu2%pr2\">%"
				       )
				     )
				)
			      )
			     (vlax-invoke (vlax-ename->vla-object o) 'getattributes)
		    )
	     )
	   )
	 )
	)
  )
  (princ)
)

kidznok · ‎09-13-2023

Thank you.
Now I have

; ----- LISP : Call Stack -----

; [0]...C:FOO <<--

;

; ----- Error around expression -----

; (VLAX-ENAME->VLA-OBJECT O)

; in file :

; M:\# STANDARDY\ROBOCZE\Poczekalnia\foo - blok z polem.lsp

;

; error : bad argument type <#<VLA-OBJECT IAcadHatch2 0000000027D699B0>> ; expected ENTITYNAME at [vlax-ename->vla-object]

ronjonp · ‎09-13-2023

Oops .. change this:

(vlax-invoke (vlax-ename->vla-object o) 'getattributes)

To this:

(vlax-invoke (vlax-ename->vla-object b) 'getattributes)

kidznok · ‎09-13-2023

I have this one and

(defun c:foo (/ b mp o p1 p2 s sp)

;; RJP » 2021-06-23

(cond ((null (tblobjname "block" "myblock")) (alert "'MYBLOCK' not found!"))

((setq s (ssget '((0 . "HATCH,LWPOLYLINE"))))

;; Get current space

(setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))

(foreach h (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))

;; If we have an area ( some hatches don't have an area and will display '####'

(if (vlax-property-available-p (setq o (vlax-ename->vla-object h)) 'area)

(progn ;; Get the bounding box

(vla-getboundingbox (setq o (vlax-ename->vla-object h)) 'p1 'p2)

;; Set arrays to point list

(mapcar 'set '(p1 p2) (mapcar 'vlax-safearray->list (list p1 p2)))

;; Get the midpoint of the bounding box

(setq mp (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))

;; Insert a block at the midpoint

(setq b (vla-insertblock sp (vlax-3d-point mp) "myblock" 1 1 1 0))

;; Fill in 'TAG3' att with field

;;; (setpropertyvalue

;;; (vlax-vla-object->ename b)

;;; "TAG3"

;;; (strcat "%<\\AcObjProp Object(%<\\_ObjId "

;;; (itoa (vla-get-objectid o))

;;; ">%).Area \\f \"%lu2%pr2\">%"

;;; )

;; For Bricscad

(vl-some '(lambda (att)

(and (= "TAG3" (vla-get-tagstring att))

(vla-put-textstring

att

(strcat "%<\\AcObjProp Object(%<\\_ObjId "

(itoa (vla-get-objectid o))

">%).Area \\f \"%lu2%pr2\">%"

)

(vlax-invoke (vlax-ename->vla-object b) 'getattributes)

)

(princ)

)

; error : Automation Error. Method [INSERTBLOCK] not available

ronjonp · ‎09-13-2023

@kidznok

Weird .. I don't have Bricscad. So cannot troubleshoot that.

Community

area to attribute in lisp

area to attribute in lisp

area to attribute in lisp