Polyline offset selects only arcs

Polyline offset selects only arcs

a22663564
Contributor Contributor
497 Views
6 Replies
Message 1 of 7

Polyline offset selects only arcs

a22663564
Contributor
Contributor

I would like to ask everyone

This LISP can offset all polylines

You can also select only the arc offset after blasting

Is it possible not to explode on the polyline, only the arc is offset

 

(defun C:TEST ( / curve ent holdcmd holdosmode jang n pt pt1 pt2 ss tmp x)
  (defun LEN (CURVE / TLEN)
    (setq TLEN (vlax-curve-getdistatparam
   CURVE
   (vlax-curve-getendparam CURVE)
        )
    )
  )

  (command "_.UNDO" "BE")
  (if (null tee_dist)
    (setq tee_dist 0.2)
  ) ;_set global variable
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setq HOLDCMD (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
(if (setq ss (ssget '((0 . "*LWPOLYLINE,CIRCLE,ARC"))))
    (progn
      (setq n 0)
      (initget 2)
      (if (setq tmp
   (getdist
     (strcat "\noffset distance): <"
      (rtos tee_dist 2)
      ">"
     )
   )
   )
 (setq tee_dist tmp)
      ) ;_last value
      (repeat (sslength ss)
 (setq ent (ssname ss n)
       n   (1+ n)
 )

 (setq CURVE (vlax-ename->vla-object ENT)
       x     (vlax-curve-getParamAtDist curve (/ (len curve) 3.33))
       pt    (vlax-curve-getPointAtParam curve x)
 );_Get the points and parameters of the specified distance value on the line


 (setq JANG (angle '(0 0 0) (vlax-curve-getfirstderiv CURVE X)))
 (setq PT1 (polar PT (+ JANG (* 0.5 pi)) 0.00000001))
 (setq PT2 (polar PT (- JANG (* 0.5 pi)) 0.00000001))
 (command "layer" "m" "make up" "c" 1 "make up" "")
 ;;(command "_.OFFSET" (abs tee_dist) ENT PT1 "")
 (command "_.OFFSET" "L" "C" (abs tee_dist) ENT PT1 "")

 (if (or (and (> tee_dist 0) (> (LEN CURVE) (LEN (entlast))))
  (and (< tee_dist 0) (< (LEN CURVE) (LEN (entlast))))
     )
   (progn
     (entdel (entlast))
     (command "_.OFFSET" (abs tee_dist) ENT PT2 "")
   )
 )
      )
    )
  )
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "CMDECHO" HOLDCMD)
  (command "_.UNDO" "E")
  (princ)
)

 

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

CADaSchtroumpf
Advisor
Advisor

For offset only one segment (line or arc) of a lightweight polyline whitout explode it, you can try this.

(vl-load-com)
(defun c:offset_vertex ( / obj dxf_obj obj_vlax pt_sel par i pt_first pt_snd bulge e_next pt_ref lst_dxf rad p_cen dxf_210 dis_offset where_pt v1 v2 det_or)
  (while (not (setq obj (entsel "\nSelect a polyline "))))
  (cond
    ((or (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "LWPOLYLINE")
      (and
        (eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
        (zerop (boole 1 112 (cdr (assoc 70 dxf_obj))))
      )
     )
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq
        obj_vlax (vlax-ename->vla-object (car obj))
        pt_sel
        (vlax-curve-getClosestPointToProjection
          obj_vlax
          (trans (cadr obj) 1 0)
          (mapcar '- (trans (getvar "VIEWDIR") 1 0) (trans '(0 0 0) 1 0))
        )
        par (vlax-curve-getParamAtPoint obj_vlax pt_sel)
        i 0
      )
      (if (>= par (vlax-curve-getEndParam obj_vlax)) (setq par (1- par)))
        (setq pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
      )
      (if (= (1+ (fix par)) (vlax-curve-getEndParam obj_vlax))
        (setq pt_snd (trans (vlax-curve-getEndPoint obj_vlax) 0 1))
        (setq pt_snd (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par))) 0 1))
      )
      (cond
        ((eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE")
          (while (or (/= (caar dxf_obj) 42) (if (< i (fix par)) (setq i (1+ i))))
            (setq bulge (cdadr dxf_obj) dxf_obj (cdr dxf_obj))
          )
        )
        (T
          (setq e_next (entnext (cdar dxf_obj)))
          (repeat (fix par) (setq e_next (entnext e_next)))
          (setq bulge (cdr (assoc 42 (entget e_next))))
        )
      )
      (setq dxf_obj (entget (car obj)) pt_ref pt_snd)
      (if (zerop bulge)
        (setq lst_dxf
          (list
            (cons 0 "LINE")
            (cons 100 "AcDbEntity")
            (assoc 67 dxf_obj)
            (assoc 410 dxf_obj)
            (cons 8 (getvar "CLAYER"))
            (cons 100 "AcDbLine")
            (cons 10 (trans pt_first 1 0))
            (cons 11 (trans pt_snd 1 0))
            (assoc 210 dxf_obj)
          )
        )
        (setq
          dxf_210 (cdr (assoc 210 dxf_obj))
          pt_first (trans pt_first 1 dxf_210)
          pt_snd (trans pt_snd 1 dxf_210)
          rad (abs (/ (distance pt_first pt_snd) (sin (* 2.0 (atan bulge))) 2.0))
          p_cen
          (polar
            pt_first
            (if (> bulge 0.0)
              (+ (angle pt_first pt_snd) (- (/ pi 2.0) (* 2.0 (atan bulge))))
              (- (angle pt_first pt_snd) (+ (/ pi 2.0) (* 2.0 (atan bulge))))
            )
            rad
          )
          lst_dxf
          (list
            (cons 0 "ARC")
            (cons 100 "AcDbEntity")
            (assoc 67 dxf_obj)
            (assoc 410 dxf_obj)
            (cons 8 (getvar "CLAYER"))
            (cons 100 "AcDbCircle")
            (cons 10 p_cen)
            (cons 40 rad)
            (cons 100 "AcDbArc")
            (cons 50 (angle p_cen (if (> bulge 0.0) pt_first pt_snd)))
            (cons 51 (angle p_cen (if (> bulge 0.0) pt_snd pt_first)))
            (assoc 210 dxf_obj)
          )
        )
      )
      (foreach n '(6 39 48 62 370 420)
        (if (assoc n dxf_obj)
          (setq lst_dxf (append lst_dxf (list (assoc n dxf_obj))))
        )
      )
      (initget "Through")
      (setvar "OFFSETDIST"
        (if (not (setq dis_offset (getdist (strcat "\nSpecify the offset distance or [Through] <" (if (< (getvar "OFFSETDIST") 0) "Par" (rtos (getvar "OFFSETDIST"))) ">: "))))
          (progn (if (< (getvar "OFFSETDIST") 0) (setq dis_offset "Through")) (getvar "OFFSETDIST"))
          (if (eq dis_offset "Through") -1 dis_offset)
        )
      )
      (if (< (getvar "OFFSETDIST") 0)
        (princ "\nAssign a value to \"By the point\": ")
        (princ "\nSpecify a point on the side to offset: ")
      )
      (initget 9)
      (setq where_pt (getpoint))
      (entmake lst_dxf)
      (setq e_last (entlast))
      (if (< (getvar "OFFSETDIST") 0)
        (setvar "OFFSETDIST"
          (distance
            (vlax-curve-getClosestPointToProjection e_last
              (trans where_pt 1 0)
              (mapcar '- (trans (getvar "VIEWDIR") 1 0) (trans '(0 0 0) 1 0))
              T
            )
            (list (car (trans where_pt 1 0)) (cadr (trans where_pt 1 0)))
          )
        )
      )
      (if (eq "LINE" (cdr (assoc 0 lst_dxf)))
        (setq
          v1 (mapcar '- pt_ref pt_sel)
          v2 (mapcar '- (trans where_pt 1 0) pt_sel)
        )
        (setq
          v1 (mapcar '- (polar pt_sel (+ (angle pt_sel (trans p_cen dxf_210 0)) (/ pi 2)) rad) pt_sel)
          v2 (mapcar '- (trans where_pt 1 0) pt_sel)
        )
      )
      (setq det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2)))
      (cond
        ((> det_or 0.0) (setvar "OFFSETDIST" (abs (getvar "OFFSETDIST"))))
        ((< det_or 0.0) (setvar "OFFSETDIST" (- (abs (getvar "OFFSETDIST")))))
      )
      (if
        (and
          rad
          (eq
            (minusp
              (apply
                '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
                (append v1 (mapcar '- (trans p_cen dxf_210 0) pt_sel))
              )
            )
            (minusp det_or)
          )
          (> (abs (getvar "OFFSETDIST")) rad)
        ) 
        (princ "\nObject cannot be offset.")
        (vla-Offset (vlax-ename->vla-object e_last) (getvar "OFFSETDIST"))
      )
      (setvar "OFFSETDIST" (if (eq dis_offset "Through") -1 (abs (getvar "OFFSETDIST"))))
      (entdel e_last)
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (T
      (princ "\nIs not a valid polyline for this function!")
    )
  )
  (prin1)
)

 

Message 3 of 7

a22663564
Contributor
Contributor

Thank you for taking the time to write LISP

Can you change it to multiple object frame selection graphics and only offset arc

Because when there are too many arcs to process, this LISP can only specify one arc to offset

 

0 Likes
Message 4 of 7

CADaSchtroumpf
Advisor
Advisor
Accepted solution

So like this?

But it's hard to know which side you want to offset (unless you offset both sides together) without passing the arcs one by one.

 

(vl-load-com)
(defun c:offset_vertex_arc ( / ss_lw dis_offset n ename obj dxf_ent dxf_210 pr seg_bulge pt_first pt_snd pt_sel rad p_cen lst_dxf where_pt e_last v1 v2 det_or)
  (princ "\nSelect polylines ")
  (while (null (setq ss_lw (ssget '((0 . "LWPOLYLINE"))))))
  (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (initget "Through")
  (setvar "OFFSETDIST"
    (if (not (setq dis_offset (getdist (strcat "\nSpecify the offset distance or [Through] <" (if (< (getvar "OFFSETDIST") 0) "Par" (rtos (getvar "OFFSETDIST"))) ">: "))))
      (progn (if (< (getvar "OFFSETDIST") 0) (setq dis_offset "Through")) (getvar "OFFSETDIST"))
      (if (eq dis_offset "Through") -1 dis_offset)
    )
  )
  (repeat (setq n (sslength ss_lw))
    (setq
      ename (ssname ss_lw (setq n (1- n)))
      obj (vlax-ename->vla-object ename)
      dxf_ent (entget ename)
      dxf_210 (cdr (assoc 210 dxf_ent))
      pr -1
    )
    (repeat (fix (vlax-curve-getEndParam ename))
      (setq seg_bulge (vla-GetBulge obj (setq pr (1+ pr))))
      (cond
        ((not (zerop seg_bulge))
          (setq
            pt_first (trans (vlax-curve-GetPointAtParam ename pr) 0 dxf_210)
            pt_snd (trans (vlax-curve-GetPointAtParam ename (1+ pr)) 0 dxf_210)
            pt_sel (trans (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) 0 dxf_210)
            rad (abs (/ (distance pt_first pt_snd) (sin (* 2.0 (atan seg_bulge))) 2.0))
            p_cen
            (polar
              pt_first
              (if (> seg_bulge 0.0)
                (+ (angle pt_first pt_snd) (- (/ pi 2.0) (* 2.0 (atan seg_bulge))))
                (- (angle pt_first pt_snd) (+ (/ pi 2.0) (* 2.0 (atan seg_bulge))))
              )
              rad
            )
            lst_dxf
            (list
              (cons 0 "ARC")
              (cons 100 "AcDbEntity")
              (assoc 67 dxf_ent)
              (assoc 410 dxf_ent)
              (cons 8 (getvar "CLAYER"))
              (cons 100 "AcDbCircle")
              (cons 10 p_cen)
              (cons 40 rad)
              (cons 100 "AcDbArc")
              (cons 50 (angle p_cen (if (> seg_bulge 0.0) pt_first pt_snd)))
              (cons 51 (angle p_cen (if (> seg_bulge 0.0) pt_snd pt_first)))
              (assoc 210 dxf_ent)
            )
          )
          (foreach n '(6 39 48 62 370 420)
            (if (assoc n dxf_ent)
              (setq lst_dxf (append lst_dxf (list (assoc n dxf_ent))))
            )
          )
          (entmake lst_dxf)
          (setq e_last (entlast))
          (redraw e_last 3)
          (if (< (getvar "OFFSETDIST") 0)
            (princ "\nAssign a value to \"By the point\": ")
            (princ "\nSpecify a point on the side to offset: ")
          )
          (initget 9)
          (setq where_pt (getpoint))
          (redraw e_last 4)
          (if (< (getvar "OFFSETDIST") 0)
            (setvar "OFFSETDIST"
              (distance
                (vlax-curve-getClosestPointToProjection e_last
                  (trans where_pt 1 0)
                  (mapcar '- (trans (getvar "VIEWDIR") 1 0) (trans '(0 0 0) 1 0))
                  T
                )
                (list (car (trans where_pt 1 0)) (cadr (trans where_pt 1 0)))
              )
            )
          )
          (setq
            v1 (mapcar '- (polar pt_sel (+ (angle pt_sel (trans p_cen dxf_210 0)) (/ pi 2)) rad) pt_sel)
            v2 (mapcar '- (trans where_pt 1 0) pt_sel)
          )
          (setq det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2)))
          (cond
            ((> det_or 0.0) (setvar "OFFSETDIST" (abs (getvar "OFFSETDIST"))))
            ((< det_or 0.0) (setvar "OFFSETDIST" (- (abs (getvar "OFFSETDIST")))))
          )
          (if
            (and
              rad
              (eq
                (minusp
                  (apply
                    '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
                    (append v1 (mapcar '- (trans p_cen dxf_210 0) pt_sel))
                  )
                )
                (minusp det_or)
              )
              (> (abs (getvar "OFFSETDIST")) rad)
            ) 
            (princ "\nObject cannot be offset.")
            (vla-Offset (vlax-ename->vla-object e_last) (getvar "OFFSETDIST"))
          )
          (setvar "OFFSETDIST" (if (eq dis_offset "Through") -1 (abs (getvar "OFFSETDIST"))))
          (entdel e_last)
        )
      )
    )
  )
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (prin1)
)

 

0 Likes
Message 5 of 7

Kent1Cooper
Consultant
Consultant

Are there limits to the configurations you would use this on?  Can you illustrate a typical situation, before and after?

 

For example, in the following image, from the original Polyline on the left, all three of the rest, plus the mirror image of the last one, are possible results of Offsetting the arc segment outward [with the dotted green showing the original shape].  But going inward is not possible at all if you want the Polyline to remain whole.

Kent1Cooper_0-1661946770311.png

Offsetting an arc segment that is tangent to a line segment on either or both side(s) inward is similarly impossible -- the impossibility is not only when the adjacent segments are parallel.  And there are countless possible configurations that could have oddball results:

Kent1Cooper_1-1661947333772.png

 

Kent Cooper, AIA
0 Likes
Message 6 of 7

john.uhden
Mentor
Mentor

@a22663564 

Yes.  That's what my XOFFSET does...

It recreates the segment, even nested in a block or xref and then you have a dialog choice of layer, color, etc.

OR you can offset the whole polyline, or just clone it or a segment with an offset of 0.

You can see what you're about to pick before you pick it thanks to glyphs at endpoints.

John F. Uhden

0 Likes
Message 7 of 7

a22663564
Contributor
Contributor

I have achieved the effect I want

Attach LISP here

 

(defun 3pcen(p1 p2 p3)
  	(setq 	p1 (list(/(+(car p1)(car p2))2)(/(+(cadr p1)(cadr p2))2))
        	p3 (list(/(+(car p2)(car p3))2)(/(+(cadr p2)(cadr p3))2))
	)
	(inters p1 (polar p1(+(/ pi 2)(angle p1 p2))1)
		p3 (polar p3(+(/ pi 2)(angle p3 p2))1)
		nil
	)
)
(defun tt (e tc / en n p p1 p0 r bugle i)
	(setq en (entget e '("*"))
	      n  (vlax-curve-getendparam e)
	      e  (vlax-ename->vla-object e)
	      i -1
	)
  	(while (< (setq i (1+ i)) n)
      		(or (VL-CATCH-ALL-ERROR-P
		    	(setq p (vlax-curve-getpointatparam e i)
                              bugle (VL-CATCH-ALL-APPLY'vlax-invoke-method (List  e 'GetBulge i))
			)
		    )
         	    (and (/= bugle 0)
             		 (setq p1 (vlax-curve-getpointatparam e (1+ i)))
             		 (setq p0(vlax-curve-getpointatparam e(+ i 0.5)))
             		 (setq p0(3pcen p p0 p1)r(+(distance p0 p)d))
             		 (entmakex
			   	(subst (cons 8 tc) (assoc 8 entlst)
				   	(setq entlst 
					 	(vl-remove 'nil
							(append
								(mapcar 'cons '(0 100 100 90 70 10 42 10)
			                             			(list "LWPOLYLINE" "AcDbEntity" "AcDbPolyline" 2 128 (polar p0(angle p0 p)r) bugle (polar p0 (angle p0 p1)r))
								)
		                             			(mapcar '(lambda(x) (assoc x en))'(6 8 62 370 38 -3))
							)
						)
					)
				)
			 )
		    )
		)
	)
)
(defun c:tt (/ e d i)
	(or(setq d(getdist"offset distance;[0.2]"))(setq d 0.2))
  	
;;;  	(while (setq e (ssget":E:S"'((0 . "lwpolyline")(-4 . "/=")(42 . 0))))
;;;	  	
;;;    		(tt (ssname e 0))
;;;	  	
;;;    	)
  	(setq cly (getvar "clayer"))
  	(command "layer" "m" "bmcl" "C" 1 "" "")
  	(setq e (ssget))
  	(setq i 0)
	(repeat (sslength e)
		(tt (ssname e i) "bmcl")
	  	(setq i (1+ i))
	)
	(command "layer" "m" cly "")

)

 

0 Likes