Modify LISPS to place ACAD Point in centroids of Poylilines with specific order

Modify LISPS to place ACAD Point in centroids of Poylilines with specific order

Anonymous
Not applicable
959 Views
6 Replies
Message 1 of 7

Modify LISPS to place ACAD Point in centroids of Poylilines with specific order

Anonymous
Not applicable

Hello folks,

 

I have 2 LISPS and I would like to know if its possible to make 1 other LISP out of them: my goal is to create an ACAD Point in the centroid of a Polyline from upper left to down right. 99,9% of the cases are polylines of rectangular shapes (4 vertices).

 

For this task, I have a first lisp that finds the centroid of each selected polyline (I can select all polylines at once) and places a point in its centroid, but in random order: 

 

(defun c:PC ( / acdoc acspc acsel reg ) (vl-load-com)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
)
(if (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
(progn
(vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc))
(vlax-invoke acspc 'addpoint
(trans (vlax-get (setq reg (car (vlax-invoke acspc 'addregion (list obj)))) 'Centroid) 1 0)
)
(vla-delete reg)
)
(vla-delete acsel)
)
)
(princ)
)
(c:PC)
(princ)

 

Then, after running the first LISP, I need to convert all the randomly ordered points that were created to circles and then run this second LISP that converts all the circles at once to ACAD Points, but now in correct order (from upper left to down right):

 

defun c:C2P (/ s)
(cond ((setq s (ssget ":L" '((0 . "circle"))))
(foreach p (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
(setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
)
'(lambda (a b)
(if (equal (cadr a) (cadr b) 1e-8)
(< (car a) (car b))
(> (cadr a) (cadr b))
)
)
)
(entmakex (list '(0 . "point") (cons 10 p) '(8 . "0")))
)
;; Uncomment the line below to delete the circles
;; (mapcar 'entdel s)
)
)
(princ)
)
(vl-load-com)

 

Is there any way to run just one LISP that is going to find the centroid of those polylines and create ACAD Points in their centroids from upper left to down right at once?

 

Someone can help to get this task done? Thanks a lot.

0 Likes
Accepted solutions (1)
960 Views
6 Replies
Replies (6)
Message 2 of 7

Sea-Haven
Mentor
Mentor

A centroid is exactly that if you want a point just at the middle of two corners then use a bounding box method. 

0 Likes
Message 3 of 7

Anonymous
Not applicable

@Sea-Haven wrote:

A centroid is exactly that if you want a point just at the middle of two corners then use a bounding box method. 


 

Sorry, my experience for understanding this coding is above sea and under heaven @Sea-Haven ...

0 Likes
Message 4 of 7

dlanorh
Advisor
Advisor

Why does it matter if the points are created in order from top left to bottom right?

The first lisp doesn't create points in a random order, but in the order the selection set is created.

 

Why convert points to circles and then back to points? you could just sort the coords from lisp 1 and insert them as points, or are you trying to do something else in between?

I am not one of the robots you're looking for

0 Likes
Message 5 of 7

dlanorh
Advisor
Advisor
Accepted solution

Try this, untested

 

(defun c:PC ( / acdoc acspc ss reg pt_lst) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
        ss (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
        pt_lst nil
  )
  (cond (ss
          (vlax-for obj (setq ss (vla-get-activeselectionset acdoc))
            (setq pt_lst (cons (trans (vlax-get (setq reg (car (vlax-invoke acspc 'addregion (list obj)))) 'Centroid) 1 0) pt_lst))
            (vla-delete reg)
          )
          (vla-delete ss)
          (setq pt_lst (vl-sort pt_lst '(lambda (a b) (if (equal (cadr a) (cadr b) 1e-8) (< (car a) (car b)) (> (cadr a) (cadr b))))))
          (foreach pt pt_lst
            (vlax-invoke acspc 'addpoint pt)
          )  
        )
  )
  (princ)
)
(c:PC)
(princ)

I am not one of the robots you're looking for

0 Likes
Message 6 of 7

Anonymous
Not applicable

 


@dlanorh wrote:

Why does it matter if the points are created in order from top left to bottom right?

The first lisp doesn't create points in a random order, but in the order the selection set is created. Can you help me with that?

 

Why convert points to circles and then back to points? you could just sort the coords from lisp 1 and insert them as points, or are you trying to do something else in between?


 

No, I'm just doing the step of conversion from circles to points because the second lisp creates points always from upper left to down right although the selection order, which is my wish and the order desired for the points that will be after converted to COGO points. So, I just want that the LISP always use this order (upper left to down right).

0 Likes
Message 7 of 7

Anonymous
Not applicable

@dlanorh wrote:

Try this, untested

 

(defun c:PC ( / acdoc acspc ss reg pt_lst) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
        ss (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
        pt_lst nil
  )
  (cond (ss
          (vlax-for obj (setq ss (vla-get-activeselectionset acdoc))
            (setq pt_lst (cons (trans (vlax-get (setq reg (car (vlax-invoke acspc 'addregion (list obj)))) 'Centroid) 1 0) pt_lst))
            (vla-delete reg)
          )
          (vla-delete ss)
          (setq pt_lst (vl-sort pt_lst '(lambda (a b) (if (equal (cadr a) (cadr b) 1e-8) (< (car a) (car b)) (> (cadr a) (cadr b))))))
          (foreach pt pt_lst
            (vlax-invoke acspc 'addpoint pt)
          )  
        )
  )
  (princ)
)
(c:PC)
(princ)


 

It just worked perfectly my friend! Just what I wanted. Thanks for helping me with this. 🙂

0 Likes