Jump to content
hanskes

lisp, place block on geometric center of polyline

Recommended Posts

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?

Share this post


Link to post
Share on other sites
Tharwat

Are you referring to attributed or regular block?

What is the name of the block?

Share this post


Link to post
Share on other sites
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 by mhupp

Share this post


Link to post
Share on other sites
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)
)

 

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...