Offset by Centroid - need help

[ChrisCMU]

I am trying to automate creating a polyline inside a set of multiple lines selected by the user (note: lines will always intersect at ends so error checking is not in here but should be added at some point).

 

(defun OffsetInside ( / dist last)

(setq dist (getreal "\nEnter offset distance"))

(command "filedia" "0")

(command "PEDITACCEPT" "1")

(command "pedit" "m" (ssget) "" "j" "0" "")

(setq last (ssget "l" ))

(command "offset" dist last (get_centroid) "")

(command "explode" last)

(command "filedia" "1")

)

It calls the get centroid function I found on here (to get the side to offset to):

 

(defun get_centroid ()

(vl-load-com)

 

(setq adoc (vla-get-activedocument

(vlax-get-acad-object)

)

)

(if (and

(= (getvar "tilemode") 0)

(= (getvar "cvport") 1)

)

(setq acsp (vla-get-paperspace adoc))

(setq acsp (vla-get-modelspace adoc))

)

(setq util (vla-get-utility adoc))

(vla-getentity util 'plineObj 'pickPt "\nSelect a polyline:\n")

(if (and (wcmatch (vla-get-objectname plineObj) "*Polyline")

(eq :vlax-true (vla-get-closed plineObj)))

(progn

(setq regionObj (car (vlax-invoke acsp 'Addregion (list plineObj))))

(setq centPoint (vlax-get regionObj 'Centroid))

 

(vl-catch-all-apply

(function (lambda()

(progn (vla-delete regionObj)

(vlax-release-object regionObj)))))

(vlax-release-object plineObj)))

centPoint

)

The problem is that it prompts me to select the polyline I want the center of (as it should in the get centroid function), but I want to pass it the variable "last" instead of prompting. No matter what I do I can't get it to work though. If I actually type "l" it will select the polyline created and continue, but I want it automated after selecting the initial lines. Any thoughts?

[alanjt]

Untested, but try replacing this line:

(vla-getentity util 'plineObj 'pickPt "\nSelect a polyline:\n")

with this:

(setq plineObj (vlax-ename->vla-object (entlast)))

 

I would strongly suggest you localize the variables in the centroid subroutine.

[ChrisCMU]

worked perfectly, thanks. I'm not good with the vla commands and didn't know what to do. thanks again.

[gile]

Hi,

 

Here's another way to get a polyline centroid (accepts polyines with arc segments).

According to the benchmarks I did, it runs about 3 times faster than the "region statement" which needs the modeler.

 

;; ALGEB-AREA
;; Returns the algebraic area of the triangle defined by three 2d points
;; the area is negative if points are clockwise

(defun algeb-area (p1 p2 p3)
 (/ (-	(* (- (car p2) (car p1))
   (- (cadr p3) (cadr p1))
)
(* (- (car p3) (car p1))
   (- (cadr p2) (cadr p1))
)
    )
    2.0
 )
)

;; TRIANGLE-CENTROID
;; Returns the centroid of a triangle defined by 3 points

(defun triangle-centroid (p1 p2 p3)
 (mapcar '(lambda (x1 x2 x3)
     (/ (+ x1 x2 x3) 3.0)
   )
  p1
  p2
  p3
 )
)

;; POLYARC-CENTROID
;; Returns a list which first item is the centroid of a 'polyarc'
;; and the second its algeraic area
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-centroid	(bu p1 p2 / ang rad cen area dist cg)
 (setq	ang  (* 2 (atan bu))
rad  (/	(distance p1 p2)
	(* 2 (sin ang))
     )
cen  (polar p1
	    (+ (angle p1 p2) (- (/ pi 2) ang))
	    rad
     )
area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
dist (/ (expt (distance p1 p2) 3) (* 12 area))
cg   (polar cen
	    (- (angle p1 p2) (/ pi 2))
	    dist
     )
 )
 (list cg area)
)

;; PLINE-CENTROID
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

(defun pline-centroid (pl / elst lst tot cen p0 area cen)
 (setq elst (entget pl))
 (while (setq elst (member (assoc 10 elst) elst))
   (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
  elst (cdr elst)
   )
 )
 (setq	lst (reverse lst)
tot 0.0
cen '(0.0 0.0)
p0  (caar lst)
 )
 (if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
  cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))
  tot (cadr p-c)
   )
 )
 (setq lst (cdr lst))
 (if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
 )
 (while (cadr lst)
   (setq area (algeb-area p0 (caar lst) (caadr lst))
  cen  (mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))
	       cen
	       (triangle-centroid p0 (caar lst) (caadr lst))
       )
  tot  (+ area tot)
   )
   (if	(/= 0 (cdar lst))
     (setq p-c	(polyarc-centroid (cdar lst) (caar lst) (caadr lst))
    cen	(mapcar	'(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
		cen
		(car p-c)
	)
    tot	(+ tot (cadr p-c))
     )
   )
   (setq lst (cdr lst))
 )
 (if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
  cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
	      cen
	      (car p-c)
      )
  tot (+ tot (cadr p-c))
   )
 )
 (trans (list (/ (car cen) tot)
       (/ (cadr cen) tot)
       (cdr (assoc 38 (entget pl)))
 )
 pl
 0
 )
)

[ChrisCMU]

well, it's not working again. I had to do some tweaking because I found out if the original lines you selected are polylines already, the program doesn't work because it won't select the correct last entity (it doesn't see the joined polyline as the last one unless it comes from lines).

 

So, I tried to modify it and not use last at all (instead sending the lines to a new layer to be selected by their properties). For some reason the get centroid function is not accepting the value I am trying to pass to it.

 

(defun OffsetInside (/ dist lines lines2 lines3 offset)

(setq dist (getreal "\nEnter offset distance: "))

(setq lines (ssget))

(command "filedia" "0")

(command "PEDITACCEPT" "1")

(command "copy" lines "" "0,0" "")

(command "-layer" "n" "offset" "")

(command "chprop" lines "" "LA" "offset" "")

(setq lines2 (ssget "x" '((8 . "offset"))))

(command "explode" lines2)

(setq lines3 (ssget "x" '((8 . "offset"))))

(command "pedit" "m" lines3 "" "j" "0" "")

(setq lines4 (ssget "x" '((8 . "offset"))))

(command "draworder" lines4 "" "Front")

(command "offset" dist lines4 (get_centroid lines4) "")

;(command "erase" lines4 "") - commented out to see results of offset while testing

(setq offset (ssget "x" '((8 . "offset"))))

(command "chprop" offset "" "LA" "patented" "")

(command "-laydel" "name" "offset" "" "y" "")

(command "filedia" "1")

)

 

 

 

(defun get_centroid (pl)

(vl-load-com)

 

(setq adoc (vla-get-activedocument

(vlax-get-acad-object)

)

)

(if (and

(= (getvar "tilemode") 0)

(= (getvar "cvport") 1)

)

(setq acsp (vla-get-paperspace adoc))

(setq acsp (vla-get-modelspace adoc))

)

(setq util (vla-get-utility adoc))

(setq ename-poly pl)

(setq vlaobject-poly (vlax-ename->vla-object ename-poly))

(if (and (wcmatch (vla-get-objectname plineObj) "*Polyline")

(eq :vlax-true (vla-get-closed plineObj)))

(progn

(setq regionObj (car (vlax-invoke acsp 'Addregion (list plineObj))))

(setq centPoint (vlax-get regionObj 'Centroid))

 

(vl-catch-all-apply

(function (lambda()

(progn (vla-delete regionObj)

(vlax-release-object regionObj)))))

(vlax-release-object plineObj)))

centPoint

)

 

gile - I tried yours but it doesn't work at all. I even commented out the entget part and coded it to ssget and after selecting manually it didn't work right.

[gile]

gile - I tried yours but it doesn't work at all. I even commented out the entget part and coded it to ssget and after selecting manually it didn't work right

 

The routine does work, you can try this:

;; PT-CEN
;; Creates a point on the selected pline centroid

(defun c:pt-cen    (/ ent elst elv)
 (and
   (setq ent (car (entsel)))
   (setq elst (entget ent))
   (setq elv (cdr (assoc 38 elst)))
   (= "LWPOLYLINE" (cdr (assoc 0 elst)))
   (entmake
     (list '(0 . "POINT") (cons 10 (pline-centroid ent)))
   )
 )
 (princ)
)

But using the pline centroid doesn't ensure you to offset inside the polyline.

The polyline centroid may be outiside the polyline:

[gile]

Using the vla-Offset function with a closed polyline can be a way to ensure an "insde offset".

 

The help file for the vla-Offset function say:

"The distance to offset the object. The offset can be a positive or negative number, but it cannot equal zero. If the offset is negative, this is interpreted as being an offset to make a "smaller" curve".

 

With a closed polyline, this is true if the polyline is counterclockwise, and it's inverse if the pline is clockwise.

A way to know if a pline is clockwise ir counterclockwise is to calculate its algebraic area: a negative area means the pline is clockwise.

 

The InsideOffset routine requieres two arguments: a polyline (ename or vla-object) and the offset distance (a positive real number).

 

You can test it using: (InsideOffset (car (enstel)))

 

;; PLINE-ALGEBRAIC-AREA (gile)
;; Returns the algebraic area of the polyline
;; the area is negative if the polyline is clockwise
;;
;; Argument: a polyline ename

(defun Pline-Algebraic-Area (pl / elst lst tot)
 (setq elst (entget pl))
 (while (setq elst (member (assoc 10 elst) elst))
   (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
     elst (cdr elst)
   )
 )
 (setq    lst (reverse lst)
   tot 0.0
   p0  (caar lst)
 )
 (if (/= 0 (cdar lst))
   (setq tot (polyarc-algeb-area (cdar lst) p0 (caadr lst))
   )
 )
 (setq lst (cdr lst))
 (if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
 )
 (while (cadr lst)
   (setq tot  (+ (triangle-algeb-area p0 (caar lst) (caadr lst)) tot))
   (if    (/= 0 (cdar lst))
     (setq tot    (+ tot (polyarc-algeb-area (cdar lst) (caar lst) (caadr lst))))
   )
   (setq lst (cdr lst))
 )
 (if (/= 0 (cdar lst))
   (setq tot (+ tot (polyarc-algeb-area (cdar lst) (caar lst) p0)))
 )
 tot
)

;; TRIANGLE-ALGEB-AREA (gile)
;; Returns the algebraic area of the triangle defined by three 2d points
;; the area is negative if points are clockwise
;;
;; Arguments: three 2d points

(defun triangle-algeb-area (p1 p2 p3)
 (/ (-    (* (- (car p2) (car p1))
      (- (cadr p3) (cadr p1))
   )
   (* (- (car p3) (car p1))
      (- (cadr p2) (cadr p1))
   )
    )
    2.0
 )
)

;; POLYARC-ALGEB-AREA (gile)
;; Returns the algeraic area of a 'polyarc'
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-algeb-area    (bu p1 p2 / ang rad)
 (setq    ang  (* 2 (atan bu))
   rad  (/    (distance p1 p2)
       (* 2 (sin ang))
        )
 )
 (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
)

;; InsideOffset (gile)
;; Offset inside a closed polyline
;;
;; Arguments
;; pl: a polyline (ename or vla-object)
;; dist: offset distance
;;
;; Returns a variant
;; (an array of the newly created objects resulting from the offset).

(defun InsideOffset (pl dist / obj)
 (vl-load-com)
 (if (= (type pl) 'ENAME)
   (setq obj (vlax-ename->vla-object pl))
   (setq obj pl
         pl  (vlax-vla-object->ename obj)
   )
 )
 (vla-offset obj
             (if (minusp (Pline-Algebraic-Area pl))
               dist
               (- dist)
             )
 )
)

[alanjt]

I was just curious if you could accomplish this w/o calculating the algebraic area. It's just a proof of concept; wanted to play around a little.

;;; Offset inside of selected objects
;;; Alan J. Thompson, 09.12.09
(defun c:OffIn (/ #Dist #SSGet #Pline #Offset)
 (vl-load-com)
 (initget 6)
 (cond
   ((and (setq #Dist (getdist "\nSpecify offset distance: "))
         (setq #SSGet (ssget ":L" '((0 . "LINE,LWPOLYLINE,ARC"))))
    ) ;_ and
    (if (zerop (getvar "peditaccept"))
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_y" "_j" "" "")
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_j" "" "")
    ) ;_ if
    (if (not (vl-catch-all-error-p
               (setq
                 #Offset
                  (vl-catch-all-apply
                    'vla-offset
                    (list (setq
                            #Pline (vlax-ename->vla-object (entlast))
                          ) ;_ setq
                          (abs #Dist)
                    ) ;_ list
                  ) ;_ vl-catch-all-apply
               ) ;_ setq
             ) ;_ vl-catch-all-error-p
        ) ;_ not
      (if (> (vla-get-area
               (setq #Offset (car (vlax-safearray->list
                                    (vlax-variant-value #Offset)
                                  ) ;_ vlax-safearray->list
                             ) ;_ car
               ) ;_ setq
             ) ;_ vla-get-area
             (vla-get-area #Pline)
          ) ;_ >
        (progn
          (vla-delete #Offset)
          (if (not (vl-catch-all-error-p
                     (setq #Offset (vl-catch-all-apply
                                     'vla-offset
                                     (list #Pline (- (abs #Dist)))
                                   ) ;_ vl-catch-all-apply
                     ) ;_ setq
                   ) ;_ vl-catch-all-error-p
              ) ;_ not
            (setq #Offset (car (vlax-safearray->list
                                 (vlax-variant-value #Offset)
                               ) ;_ vlax-safearray->list
                          ) ;_ car
            ) ;_ setq
            (setq #Offset nil)
          ) ;_ if
        ) ;_ progn
      ) ;_ if
      (alert "Item cannot be offset.")
    ) ;_ if
    (and #Pline (vla-explode #Pline))
   )
 ) ;_ cond
 (princ)
) ;_ defun

[jaiganesh]

Dear alanjt,

 

Could u please explain the steps or a basic idea of getting an internal point for offsetting the polyline? Your lisp works great but i couldnt understand how it works?

[alanjt]

Dear alanjt,

 

Could u please explain the steps or a basic idea of getting an internal point for offsetting the polyline? Your lisp works great but i couldnt understand how it works?

No problem.

All it does is offset the pline a very small distance. If the area of the offset pline is greater than the area of the original, the new one is deleted and the original is offset in the other direction. This is to get a pline inside the original. Once this is accomplished, it just extracts the first point from the new pline's coordinates. Thus returning a point inside the original pline.

[jaiganesh]

Dear alanjt,

 

sorry to trouble u, but how is the pline offset in the other direction? Say, u offset the pline by 1.5 and the area is greater, so how to offset the pline by 1.5 in the direction "opposite" to the initial direction?

[alanjt]

Dear alanjt,

 

sorry to trouble u, but how is the pline offset in the other direction? Say, u offset the pline by 1.5 and the area is greater, so how to offset the pline by 1.5 in the direction "opposite" to the initial direction?

(vla-offset Obj 1.5) or (vla-offset Obj -1.5)

[ChrisCMU]

hmm, when I opened a new drawing and drew a polyline your lisp seemed to work fine. However, when I opened one of my drawings that I'm trying to add that functionality to...it didn't work. It said "no valid objects selected" and then it offset the last entity instead.

 

I attached the drawing I am testing this on (and removed all the layers that aren't involved in the lisp). Basically I would use your function instead of the get_centriod in my last post. However, when I tested your offin lisp in here it didn't work. Could you try it and maybe see why it won't work?

 

Basically the qq layer makes up all the quarter quarters of a township. the patented layer contains offset polylines representing land ownership. The idea is to automate the creation of patented lines by selecting qq lines bounding the area. it could be a quarter quarter, but it could also be an irregular shaped area as well (which didn't work on the get centroid for some reason).

 

Thanks.

MT200040N0460E0_test.dwg

[ChrisCMU]

The routine does work, you can try this:

;; PT-CEN
;; Creates a point on the selected pline centroid

(defun c:pt-cen    (/ ent elst elv)
 (and
   (setq ent (car (entsel)))
   (setq elst (entget ent))
   (setq elv (cdr (assoc 38 elst)))
   (= "LWPOLYLINE" (cdr (assoc 0 elst)))
   (entmake
     (list '(0 . "POINT") (cons 10 (pline-centroid ent)))
   )
 )
 (princ)
)

But using the pline centroid doesn't ensure you to offset inside the polyline.

The polyline centroid may be outiside the polyline:

 

That LISP doesn't work either. You are having it print pline-centroid but that was never defined in your lisp.

 

Man, it sure is hard to get the center of a polyline.

[alanjt]

That LISP doesn't work either. You are having it print pline-centroid but that was never defined in your lisp.

 

Man, it sure is hard to get the center of a polyline.

 

It's a subroutine Gile posted.

http://www.cadtutor.net/forum/showpost.php?p=268885&postcount=4

[ChrisCMU]

It's a subroutine Gile posted.

http://www.cadtutor.net/forum/showpost.php?p=268885&postcount=4

 

I can't seem to get that to run within my current lisp:

 

(defun OffsetInside (/ lines lines2 lines3 offset)

(setq dist (getreal "\nEnter offset distance: "))

(setq lines (ssget))

(command "filedia" "0")

(command "PEDITACCEPT" "1")

(command "copy" lines "" "0,0" "")

(command "-layer" "n" "offset" "")

(command "chprop" lines "" "LA" "offset" "")

(setq lines2 (ssget "x" '((8 . "offset"))))

(command "explode" lines2)

(setq lines3 (ssget "x" '((8 . "offset"))))

(command "pedit" "m" lines3 "" "j" "0" "")

(setq pl (ssget "x" '((8 . "offset"))))

(command "draworder" pl "" "Front")

(pline-centroid)

(command "offset" dist pl [result] "")

;(command "erase" pl "") ;- commented out for testing

(setq offset (ssget "x" '((8 . "offset"))))

(command "chprop" offset "" "LA" "patented" "")

(command "-laydel" "name" "offset" "" "y")

(command "filedia" "1")

)

 

I thought as long as I had the pl object it would run fine. I'm not sure what to put in for [result], which is the output of the pline-centroid function...but it tells me the pline-function has too few arguments anyway, so I can't even get that far.

 

The lisp worked with this get_centroid code below, but sometimes it offset outside the closed polyline. I had it call the function instead of (pline-centroid) and passed the offset command centPoint (the result of the code below):

 

(defun get_centroid ()

(vl-load-com)

 

(setq adoc (vla-get-activedocument

(vlax-get-acad-object)

)

)

(if (and

(= (getvar "tilemode") 0)

(= (getvar "cvport") 1)

)

(setq acsp (vla-get-paperspace adoc))

(setq acsp (vla-get-modelspace adoc))

)

(setq util (vla-get-utility adoc))

(vla-getentity util 'plineObj 'pickPt "\nSelect a polyline:\n")

(if (and (wcmatch (vla-get-objectname plineObj) "*Polyline")

(eq :vlax-true (vla-get-closed plineObj)))

(progn

(setq regionObj (car (vlax-invoke acsp 'Addregion (list plineObj))))

(setq centPoint (vlax-get regionObj 'Centroid))

 

(vl-catch-all-apply

(function (lambda()

(progn (vla-delete regionObj)

(vlax-release-object regionObj)))))

(vlax-release-object plineObj)))

centPoint

)

[gile]

Did you read the comments of pline-centroid routine header ?

 

;; PLINE-CENTROID
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

[ChrisCMU]

Did you read the comments of pline-centroid routine header ?

 

;; PLINE-CENTROID
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

 

Of course I did. I just don't know how to make it work. I'm a self taught lisper with only a few months of experience.

[leone]

tanks fo r offsetin

[alanjt]

tanks fo r offsetin

LoL

I'm glad you could make heads or tails of my clunky mess.