lisp, place block on geometric center of polyline

[hanskes]

I want to place a specific block on the geometric center of all polylines longer than 550mm and shorter than 650mm in my drawing. Any idea how I can do that in Lisp?

[hanskes]

the polylines are  closed polygons.

[Tharwat]

Are you referring to attributed or regular block?

What is the name of the block?

[mhupp]

This might work.

;;;-----------------------------------------------------
;;; Insert Block geomectric center of closed poly
(defun C:Foo (/ ss i ent Pt)
  (vl-load-com)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (setq i -1)
  (while (setq ent (ssname ss (setq i (1+ i))))
    (setq len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
    (cond
      ((and (> len 550) (< len 650)
            (setq Pt (osnap (vlax-curve-getStartPoint ent) "gcen"))
            (command "_.-INSERT" Block Pt "" "" "")
       )
      )
    )

  )
  (princ)
) 

 

Edited September 16, 2020 by mhupp

[BIGAL]

My rehash uses the pointatdist method. Open or closed.

 

;;;-----------------------------------------------------
;;; Insert Block geomectric center of closed poly


(defun C:Foo (/ ss i ent Pt)
  (vl-load-com)
(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  
(repeat (setq i (sslength ss))
  (setq obj (vlax-ename->vla-object(ssname ss (setq i (1- i)))))
    (setq len (vla-get-length obj))
      (if (and (> len 550) (< len 650))
	  (progn
            (setq Pt (vlax-curve-getPointatdist obj (/ len 2.0)))
            (command "_.-INSERT" Block Pt "" "" "")
	  )
      )
)
(princ)
)

 

[dlanorh]

22 hours ago, hanskes said:

I want to place a specific block on the geometric center of all polylines longer than 550mm and shorter than 650mm in my drawing. Any idea how I can do that in Lisp?

 

This should insert the block at the centroid (geometric centre) of the polyline. You will need to put the name of your block where the variable "blk" is set. The blocks are inserted on the current layer.

 

There may be a lag when the lisp first runs as the required arx/dll's are loaded.

 

(vl-load-com)

(defun c:test (/ *error* spc sv_lst sv_vals blk ss cnt obj ent len robj pt bobj)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
    (princ)
  );end_defun

  (setq spc (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        blk ;"PUT BLOCK NAME HERE"
        ss (ssget "_X" '((0 . "LWPOLYLINE")))
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (repeat (setq cnt (sslength ss))
    (setq obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
          len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
    );end_setq
    (cond ( (and (< 550 len 650) (listp (setq robj (vl-catch-all-apply 'vlax-invoke (list spc 'addregion (list obj))))))
            (setq pt (vlax-get (setq robj (car robj)) 'centroid))
            (if (= (length pt) 2) (setq pt (reverse (cons 0.0 (reverse pt)))))
            (setq bobj (vlax-invoke spc 'insertblock pt blk 1.0 1.0 1.0 0.0))
            (vl-catch-all-apply 'vla-delete (list robj))
          )
    );end_cond
  );end_repeat

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

 

[hanskes]

Thank you for your quick responses! With dlanorh's solution, I get this error: Oops an Error: too few / too many arguments at [SETQ] occurre

Both solutions from mhupp and bigal work. However, the block is not inserted on all polylines, I think because the block has an attibute (DOORWAP). Also, in the bigal solution, the block is inserted at the bottom right corner instead of in the center.

 

I had also forgotten to indicate that I work with Bricscad. Perhaps the reason why dlanorh's solution doesn't work?

Edited September 21, 2020 by hanskes

[hanskes]

I tried to combine the code from mhupp and bigal, to get the geometric center of the polyline, but without success. In addition, the inserted block must be inserted with a different scale depending on the length of the polyline. See my attempt below. However, this one gives the error:  error : bad argument type <NIL> ; expected VLA-OBJECT at [vlax-curve-getendparam]

 

(defun C:SCHSPtest (/ ss i ent Pt)
(vl-load-com)
(command  "-insert" (findfile "23-Geelensparingen.dwg") "0,-100000,0" "" "" "" ) 
(command "._layer" "m" "schoormans-sparingen" "c" "96" "schoormans-sparingen" "")  
(command "_.explode"  (ssget "_X" '((0 . "INSERT")(-4 . "<not") (8 . "schoormans-sparingen") (-4 . "not>") )) )
(setq ss (ssget "_X" '((-4 . "<and") (62 . 250) (0 . "LWPOLYLINE") (-4 . "and>"))))
  
(repeat (setq i (sslength ss))
  (setq obj (vlax-ename->vla-object(ssname ss (setq i (1- i)))))
    (setq len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
      (if (and (> len 390) (< len 410))
	  (progn
            (setq Pt (osnap (vlax-curve-getStartPoint obj) "gcen"))
            (command "-INSERT" "TSD2" Pt "100" "100" "0")
	  )
      )
      (if (and (> len 490) (< len 510))
	  (progn
			(setq Pt (osnap (vlax-curve-getStartPoint obj) "gcen"))
            (command "-INSERT" "TSD2" Pt "200" "50" "0")
	  )
      )	  
      (if (and (> len 590) (< len 610))
	  (progn
            (setq Pt (osnap (vlax-curve-getStartPoint obj) "gcen"))
            (command "-INSERT" "TSD2" Pt "150" "150" "0")
	  )
      )
      (if (and (> len 790) (< len 810))
	  (progn
			(setq Pt (osnap (vlax-curve-getStartPoint obj) "gcen"))
            (command "-INSERT" "TSD2" Pt "200" "200" "0")
	  )
      )	  
)
(command "_.erase" (ssget "_X" '((-4 . "<and")(0 . "LWPOLYLINE") (62 . 250) (-4 . "and>"))) "")
(princ)
)

The reason I do not specify the exact length of the polyline is because the drawing is an export from another cad program and therefore contains rounding errors. Each polyline has a slightly different length.

 

In addition, there are also rectangular polygons with a length around 500mm, it is possible, if the polygon is higher than it is wide, instead of:

(command "-INSERT" "TSD" Pt "200" "50" "0")

to insert the block with this scaling:

(command "-INSERT" "TSD" Pt "50" "200" "0")

thank you in advance!

Edited September 21, 2020 by hanskes

[dlanorh]

4 hours ago, hanskes said:

Thank you for your quick responses! With dlanorh's solution, I get this error: Oops an Error: too few / too many arguments at [SETQ] occurre

Both solutions from mhupp and bigal work. However, the block is not inserted on all polylines, I think because the block has an attibute (DOORWAP). Also, in the bigal solution, the block is inserted at the bottom right corner instead of in the center.

 

I had also forgotten to indicate that I work with Bricscad. Perhaps the reason why dlanorh's solution doesn't work?

 

Did you place the name of your block on this line in the first (setq ...)?

 

 

 

blk ;"PUT BLOCK NAME HERE"

 

[mhupp]

it would be cleaner and faster to use COND instead of all those IF's

https://www.afralisp.net/autolisp/tutorials/cond-vs-if.php

 

as for finding the longer side. maybe something like this.

  (vlax-invoke-method (vlax-ename->vla-object obj) 'getboundingbox 'minpt 'maxpt)
  (setq pt1 (trans (vlax-safearray->list minpt) 0 obj))
  (setq pt2 (trans (vlax-safearray->list maxpt) 0 obj))  
  (setq x (- (car pt2) (car pt1))) 
  (setq y (- (cadr pt2) (cadr pt1)))
  (if (> x Y)
    (command "-INSERT" "TSD" Pt "200" "50" "0")
    (command "-INSERT" "TSD" Pt "50" "200" "0")
  )
	

not tested to busy today.

---

also in the BricsCAD Boat!

Edited September 22, 2020 by mhupp