Hellow~ , Would you see this message. about this AutoLisp .

June 1, 2018

Hi , It's an honor to meet you.

I'm looking for a autoLisp like this picture.

I beg you. god bless you.

Please contact me.

June 1, 2018

Are the three original shapes depicted in your image comprised of lines or polylines?

June 1, 2018

This looked fun to write

([color=BLUE]defun[/color] c:segoff ( [color=BLUE]/[/color] a b d e i l n p s v x y z )
   ([color=BLUE]initget[/color] 6)
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] d ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify offset: "[/color]))
            ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . 1) (-4 . [color=MAROON]"<NOT"[/color]) (-4 . [color=MAROON]"<>"[/color]) (42 . 0.0) (-4 . [color=MAROON]"NOT>"[/color]))))
       )
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)
                 e ([color=BLUE]ssname[/color] s i)
                 x ([color=BLUE]entget[/color] e)
                 p (LM:defaultprops x)
                 z ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 38 x)))
                 l [color=BLUE]nil[/color]
           )
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] v ([color=BLUE]assoc[/color] 10 x))
               ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]append[/color] ([color=BLUE]cdr[/color] v) z) l)
                     x ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] v x))
               )
           )
           ([color=BLUE]setq[/color] n ([color=BLUE]/[/color] [color=BLUE]pi[/color] ([color=BLUE]if[/color] (LM:listclockwise-p l) 2 -2)))
           ([color=BLUE]mapcar[/color]
              '([color=BLUE]lambda[/color] ( x y [color=BLUE]/[/color] a b )
                   ([color=BLUE]setq[/color] a ([color=BLUE]+[/color] ([color=BLUE]angle[/color] x y) n)
                         b ([color=BLUE]list[/color] x ([color=BLUE]polar[/color] x a d) ([color=BLUE]polar[/color] y a d) y)
                   )
                   ([color=BLUE]mapcar[/color]
                      '([color=BLUE]lambda[/color] ( a b )
                           ([color=BLUE]entmake[/color] ([color=BLUE]vl-list*[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] a e 0)) ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] b e 0)) p))
                       )
                       b ([color=BLUE]cdr[/color] b)
                  )
               )
               ([color=BLUE]cons[/color] ([color=BLUE]last[/color] l) l) l
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; List Clockwise-p - Lee Mac[/color]
[color=GREEN];; Returns T if the point list is clockwise oriented[/color]

([color=BLUE]defun[/color] LM:listclockwise-p ( lst )
   ([color=BLUE]minusp[/color]
       ([color=BLUE]apply[/color] '[color=BLUE]+[/color]
           ([color=BLUE]mapcar[/color]
               ([color=BLUE]function[/color]
                   ([color=BLUE]lambda[/color] ( a b )
                       ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color] b) ([color=BLUE]cadr[/color] a)) ([color=BLUE]*[/color] ([color=BLUE]car[/color] a) ([color=BLUE]cadr[/color] b)))
                   )
               )
               lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
           )
       )
   )
)

[color=GREEN];; Default Properties  -  Lee Mac[/color]
[color=GREEN];; Returns a list of DXF properties for the supplied DXF data,[/color]
[color=GREEN];; substituting default values for absent DXF groups[/color]

([color=BLUE]defun[/color] LM:defaultprops ( enx )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] ([color=BLUE]car[/color] x) enx)) ( x )))
      '(
           (006 . [color=MAROON]"BYLAYER"[/color])
           (008 . [color=MAROON]"0"[/color])
           (039 . 0.0)
           (048 . 1.0)
           (062 . 256)
           (370 . -1)
       )
   )
)

([color=BLUE]princ[/color])

Edited June 1, 2018 by Lee Mac

June 1, 2018

Nice Lee

June 1, 2018

Nice Lee

Cheers Ron

June 2, 2018

This looked fun to write

([color=BLUE]defun[/color] c:segoff ( [color=BLUE]/[/color] [color="red"]a[/color] b [color="red"]d e i l n[/color] p s v x y z )..

daniel ?

@Nice Lee vanilla

VL- i think slower, this accepts polyline with bulge/arc

[color="green"]known bug - sometimes arc offset wrong direction[/color]

(defun c:offs ( / xy ob s d i l )
 (prompt "\nSelect closed polylines ") 
     (and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
      (progn (initget 7)
          (setq xy '((l)(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
         d (getdist "\nSpecify offset: "))
 )
 (repeat (setq i (sslength s))
   (setq ob (vlax-ename->vla-object (ssname s (setq i (1- i))))
   l (xy (vlax-get ob 'coordinates))
  )
       (mapcar '(lambda (x / o )
	     (mapcar
	        ''((f) (setq f (eval (read (strcat "vlax-curve-get" f )))
	                     o (vlax-invoke x 'offset
			        ((if ( [color="blue"]LM:listclockwise-p[/color] l )
			           + - 
			         )
			         d
			        )
		              )
	                  )
		       (entmakex (list '(0 . "LINE")(cons 10 (f x ))(cons 11 (f (car o)))))
	           )
	      '( "startpoint" "Endpoint" )
	     )
	   (vla-erase x)
	  )
      (vlax-invoke ob 'explode)
 ) ;mapcar
     ) ; repeat 
  ) ;and
 (princ)
)

June 5, 2018

This looked fun to write

([color=BLUE]defun[/color] c:segoff ( [color=BLUE]/[/color] a b d e i l n p s v x y z )
   ([color=BLUE]initget[/color] 6)
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] d ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify offset: "[/color]))
            ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . 1) (-4 . [color=MAROON]"<NOT"[/color]) (-4 . [color=MAROON]"<>"[/color]) (42 . 0.0) (-4 . [color=MAROON]"NOT>"[/color]))))
       )
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)
                 e ([color=BLUE]ssname[/color] s i)
                 x ([color=BLUE]entget[/color] e)
                 p (LM:defaultprops x)
                 z ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 38 x)))
                 l [color=BLUE]nil[/color]
           )
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] v ([color=BLUE]assoc[/color] 10 x))
               ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]append[/color] ([color=BLUE]cdr[/color] v) z) l)
                     x ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] v x))
               )
           )
           ([color=BLUE]setq[/color] n ([color=BLUE]/[/color] [color=BLUE]pi[/color] ([color=BLUE]if[/color] (LM:listclockwise-p l) 2 -2)))
           ([color=BLUE]mapcar[/color]
              '([color=BLUE]lambda[/color] ( x y [color=BLUE]/[/color] a b )
                   ([color=BLUE]setq[/color] a ([color=BLUE]+[/color] ([color=BLUE]angle[/color] x y) n)
                         b ([color=BLUE]list[/color] x ([color=BLUE]polar[/color] x a d) ([color=BLUE]polar[/color] y a d) y)
                   )
                   ([color=BLUE]mapcar[/color]
                      '([color=BLUE]lambda[/color] ( a b )
                           ([color=BLUE]entmake[/color] ([color=BLUE]vl-list*[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] a e 0)) ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] b e 0)) p))
                       )
                       b ([color=BLUE]cdr[/color] b)
                  )
               )
               ([color=BLUE]cons[/color] ([color=BLUE]last[/color] l) l) l
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; List Clockwise-p - Lee Mac[/color]
[color=GREEN];; Returns T if the point list is clockwise oriented[/color]

([color=BLUE]defun[/color] LM:listclockwise-p ( lst )
   ([color=BLUE]minusp[/color]
       ([color=BLUE]apply[/color] '[color=BLUE]+[/color]
           ([color=BLUE]mapcar[/color]
               ([color=BLUE]function[/color]
                   ([color=BLUE]lambda[/color] ( a b )
                       ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color] b) ([color=BLUE]cadr[/color] a)) ([color=BLUE]*[/color] ([color=BLUE]car[/color] a) ([color=BLUE]cadr[/color] b)))
                   )
               )
               lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
           )
       )
   )
)

[color=GREEN];; Default Properties  -  Lee Mac[/color]
[color=GREEN];; Returns a list of DXF properties for the supplied DXF data,[/color]
[color=GREEN];; substituting default values for absent DXF groups[/color]

([color=BLUE]defun[/color] LM:defaultprops ( enx )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] ([color=BLUE]car[/color] x) enx)) ( x )))
      '(
           (006 . [color=MAROON]"BYLAYER"[/color])
           (008 . [color=MAROON]"0"[/color])
           (039 . 0.0)
           (048 . 1.0)
           (062 . 256)
           (370 . -1)
       )
   )
)

([color=BLUE]princ[/color])

daniel ?

@Nice Lee vanilla

VL- i think slower, this accepts polyline with bulge/arc

[color="green"]known bug - sometimes arc offset wrong direction[/color]

(defun c:offs ( / xy ob s d i l )
 (prompt "\nSelect closed polylines ") 
     (and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
      (progn (initget 7)
          (setq xy '((l)(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
         d (getdist "\nSpecify offset: "))
 )
 (repeat (setq i (sslength s))
   (setq ob (vlax-ename->vla-object (ssname s (setq i (1- i))))
   l (xy (vlax-get ob 'coordinates))
  )
       (mapcar '(lambda (x / o )
	     (mapcar
	        ''((f) (setq f (eval (read (strcat "vlax-curve-get" f )))
	                     o (vlax-invoke x 'offset
			        ((if ( [color="blue"]LM:listclockwise-p[/color] l )
			           + - 
			         )
			         d
			        )
		              )
	                  )
		       (entmakex (list '(0 . "LINE")(cons 10 (f x ))(cons 11 (f (car o)))))
	           )
	      '( "startpoint" "Endpoint" )
	     )
	   (vla-erase x)
	  )
      (vlax-invoke ob 'explode)
 ) ;mapcar
     ) ; repeat 
  ) ;and
 (princ)
)

Thank you very much !!! Thank you Thank you Thank you . I 'd like to explain my heart , but My english level is very low. .... Thank you Thank you.

one more question..

I must change Layer except original polygon, to particular layer, Layer that I make.

again Thank you . I beseech your favor.

June 5, 2018

@hanhphuc

[s][color=green]known bug - sometimes arc offset wrong direction[/color][/s]

But you already knew this...

;; arc offset is always in direction so that new arc is larger than its reference arced segment of lwpolyline

(defun c:offs ( / LM:listclockwise-p LM:defaultprops xy e ob p s d i l )

 (vl-load-com)

 ;; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented

 (defun LM:listclockwise-p ( lst )
   (minusp
     (apply '+
       (mapcar
         ''(( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b)))
         )
         lst (cons (last lst) lst)
       )
     )
   )
 )

 ;; Default Properties  -  Lee Mac
 ;; Returns a list of DXF properties for the supplied DXF data,
 ;; substituting default values for absent DXF groups

 (defun LM:defaultprops ( enx )
   (mapcar ''(( x ) (cond ((assoc (car x) enx)) ( x )))
    '(
       (006 . "BYLAYER")
       (008 . "0")
       (039 . 0.0)
       (048 . 1.0)
       (062 . 256)
       (370 . -1)
     )
   )
 )

 (prompt "\nSelect closed lwpolylines...") 
 (and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
   (progn (initget 7)
     (setq xy '(( l )(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
              d (getdist "\nPick or specify offset : ")
     )
   )
   (repeat (setq i (sslength s))
     (setq e  (ssname s (setq i (1- i)))
           ob (vlax-ename->vla-object e)
           p  (LM:defaultprops (entget e))
           l  (xy (vlax-get ob 'coordinates))
     )
     (mapcar 
       ''(( x )
         (mapcar
           ''(( f / o ) (setq f (eval (read (strcat "vlax-curve-get" f)))
                              o (vlax-invoke x 'offset
                                  ( (if (LM:listclockwise-p l)
                                       +
                                       - 
                                    )
                                    d
                                  )
                                )
                        )
                        (entmake (vl-list* '(0 . "LINE") (cons 10 (f x)) (cons 11 (f (car o))) p))
           )
           '("startpoint" "endpoint")
         )
         (vla-erase x)
       )
       (vlax-invoke ob 'explode)
     ) ;mapcar
   ) ;repeat 
 ) ;and
 (princ)
)

Edited June 5, 2018 by marko_ribar

June 6, 2018

marko_ribar,

I tried setting the DXF code 008 to the layer that I want the tabs to be but it won't change them, What am I doing wrong?

Thanks,

Brian

June 6, 2018

If you are referring to (LM:defaultprops), don't change anything in the code... You have to set reference LWPOLYLINE you operate on to the layer you want prior executing routine...

June 6, 2018

HI~ THAK YOU FOR YOUR KINDNESS. THANK YOU.

I HAVE ONE MORE QUESTION.

I must change Layer except original polygon, to particular layer, Layer that I make.

HOW CAN I CHAGE LAYER MAKED ENTITIES EXCEPT ORIGINAL POLYGON. ?

THAK YOU FOR YOUR HELP.

June 6, 2018

Are you referring to newly created lines and arcs (create them in currently active layer) and leave original polyline in its currently assigned layer it is already placed in?

June 6, 2018

Marko_ribar,

So what do the Defaults do for the lisp? I added this to the code to get the new lines to change to a different layer.

(entmake (vl-list* '(0 . "LINE") (cons 10 (trans a e 0)) (cons 11 (trans b e 0)) p))
      (vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object (entlast)) 'Layer "Router - Blue - Cuts"))

June 6, 2018

Create new layer and make it current, also change current color to what you desire and finally apply this revision :

;; arc offset is always in direction so that new arc is larger than its reference arced segment of lwpolyline

(defun c:offs ( / LM:listclockwise-p xy ob s d i l cc )

 (vl-load-com)

 ;; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented

 (defun LM:listclockwise-p ( lst )
   (minusp
     (apply '+
       (mapcar
         ''(( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b)))
         )
         lst (cons (last lst) lst)
       )
     )
   )
 )

 (vl-cmdf "_.UNDO" "_BEGIN")
 (prompt "\nSelect closed lwpolylines...")
 (and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
   (progn (initget 7)
     (setq xy '(( l )(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
            d (getdist "\nPick or specify offset : ")
           cc (getvar 'cecolor)
     )
   )
   (repeat (setq i (sslength s))
     (setq ob (vlax-ename->vla-object (ssname s (setq i (1- i))))
            l (xy (vlax-get ob 'coordinates))
     )
     (mapcar 
       ''(( x )
         (mapcar
           ''(( f / o ) (setq f (eval (read (strcat "vlax-curve-get" f)))
                              o (vlax-invoke x 'offset
                                  ( (if (LM:listclockwise-p l)
                                       +
                                       - 
                                    )
                                    d
                                  )
                                )
                        )
                        (entmake (list '(0 . "LINE") (cons 10 (f x)) (cons 11 (f (car o)))))
                        (entupd (cdr (assoc -1 (entmod (subst (cons 8 (getvar 'clayer)) (assoc 8 (entget (vlax-vla-object->ename (car o)))) (entget (vlax-vla-object->ename (car o))))))))
                        (cond
                          ( (= cc "BYLAYER")
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" "BYLAYER" "")
                          )
                          ( (= cc "BYBLOCK")
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" "BYBLOCK" "")
                          )
                          ( (and (> (strlen cc) 4) (= (substr cc 1 3) "RGB"))
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" "_T" (substr cc 5) "")
                          )
                          ( t
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" cc "")
                          )
                        )
           )
           '("startpoint" "endpoint")
         )
         (vla-erase x)
       )
       (vlax-invoke ob 'explode)
     ) ;mapcar
   ) ;repeat 
 ) ;and
 (vl-cmdf "_.UNDO" "_END")
 (princ)
)

Note that now you don't need (LM:defaultprops)...

HTH., M.R.

Edited June 6, 2018 by marko_ribar

June 6, 2018

@hanhphuc

But you already knew this...

Thanks for the mods, your comment guides us to fix error if offset dist inside is greater than radius of arc

update v1.1 - checks for larger radius

thanks for Lee's sub-function


[color="green"];; arc offset is always in direction so that new arc is larger than its reference arced segment of lwpolyline - M.R[/color]

(defun c:offs ( / [color="blue"]LM:listclockwise-p LM:defaultprops[/color] xy ob [color="red"]l i s p e d[/color] )

 (vl-load-com)

 [color="green"];; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented[/color]

 (defun LM:listclockwise-p ( lst )
   (minusp
     (apply '+
       (mapcar
         '(lambda( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b)))
         )
         lst (cons (last lst) lst)
       )
     )
   )
 )

[color="green"] ;; Default Properties  -  Lee Mac
 ;; Returns a list of DXF properties for the supplied DXF data,
 ;; substituting default values for absent DXF groups[/color]

 (defun LM:defaultprops ( enx )
   (mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
    '(
       (006 . "BYLAYER")
       (008 . "0")
       (039 . 0.0)
       (048 . 1.0)
       (062 . 256)
       (370 . -1)
     )
   )
 )

 (prompt "\nSelect closed lwpolylines...") 
 (and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
   (progn (initget 7)
     (setq xy '(( l )(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
            d (getdist "\nPick or specify offset : ")
     )
   )
      
   (repeat (setq i (sslength s))
     (setq e  (ssname s (setq i (1- i)))
           ob (vlax-ename->vla-object e)
           p  (LM:defaultprops (entget e))
           l  (xy (vlax-get ob 'coordinates))
     )
     
     (mapcar 
       '(lambda ( x )
          (vl-catch-all-apply 'mapcar
    (cons
               '(lambda ( f / o b r) (setq f (eval (read (strcat "vlax-curve-get" f)))
		      	   r ( (if (LM:listclockwise-p l)
                                       +
                                       -
                                       )
                                       d 
                                      )
                                o (vl-catch-all-apply 'vlax-invoke (list x 'offset r ) )
			 o (if (listp o)(car o) o )
                        	)
	   
	     (if (and (= (vla-get-ObjectName x) "AcDbArc")
		 (setq b (vl-catch-all-apply 'vlax-invoke (list x 'offset (- r)))
	               b (if (listp b) (car b) b))
		  )
	      
	      (if
		 (apply
		  	'>
			  (mapcar
			    '(lambda (a / ) (atof (vl-princ-to-string (vl-catch-all-apply 'vlax-get (list a 'Radius)))))
			     (list x b )
			    )

		  )
	       
	         (vla-erase b)
	         (progn (vla-erase o)(setq o b))
	       )

	      )

	    (entmakex (vl-list* '(0 . "LINE") (cons 10 (f x)) (cons 11 (f o)) p))

	     )
	     
           	 '(("startpoint" "endpoint"))
       )
     
            ); catch 
   
         (vla-erase x)
       )

       (vlax-invoke ob 'explode)

     ) ;mapcar
     
   ) ;repeat 
 ) ;and
 (princ)
)

June 6, 2018

I've changed my revision to include Truecolors...

June 6, 2018

Marko_ribar,

So what do the Defaults do for the lisp? I added this to the code to get the new lines to change to a different layer.
(entmake (vl-list* '(0 . "LINE") (cons 10 (trans a e 0)) (cons 11 (trans b e 0)) p))
      (vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object (entlast)) 'Layer "Router - Blue - Cuts"))

thank you for your help~

June 6, 2018

Create new layer and make it current, also change current color to what you desire and finally apply this revision :

;; arc offset is always in direction so that new arc is larger than its reference arced segment of lwpolyline

(defun c:offs ( / LM:listclockwise-p xy ob s d i l cc )

 (vl-load-com)

 ;; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented

 (defun LM:listclockwise-p ( lst )
   (minusp
     (apply '+
       (mapcar
         ''(( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b)))
         )
         lst (cons (last lst) lst)
       )
     )
   )
 )

 (vl-cmdf "_.UNDO" "_BEGIN")
 (prompt "\nSelect closed lwpolylines...")
 (and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
   (progn (initget 7)
     (setq xy '(( l )(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
            d (getdist "\nPick or specify offset : ")
           cc (getvar 'cecolor)
     )
   )
   (repeat (setq i (sslength s))
     (setq ob (vlax-ename->vla-object (ssname s (setq i (1- i))))
            l (xy (vlax-get ob 'coordinates))
     )
     (mapcar 
       ''(( x )
         (mapcar
           ''(( f / o ) (setq f (eval (read (strcat "vlax-curve-get" f)))
                              o (vlax-invoke x 'offset
                                  ( (if (LM:listclockwise-p l)
                                       +
                                       - 
                                    )
                                    d
                                  )
                                )
                        )
                        (entmake (list '(0 . "LINE") (cons 10 (f x)) (cons 11 (f (car o)))))
                        (entupd (cdr (assoc -1 (entmod (subst (cons 8 (getvar 'clayer)) (assoc 8 (entget (vlax-vla-object->ename (car o)))) (entget (vlax-vla-object->ename (car o))))))))
                        (cond
                          ( (= cc "BYLAYER")
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" "BYLAYER" "")
                          )
                          ( (= cc "BYBLOCK")
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" "BYBLOCK" "")
                          )
                          ( (and (> (strlen cc) 4) (= (substr cc 1 3) "RGB"))
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" "_T" (substr cc 5) "")
                          )
                          ( t
                            (vl-cmdf "_.CHANGE" (vlax-vla-object->ename (car o)) "" "_P" "_C" cc "")
                          )
                        )
           )
           '("startpoint" "endpoint")
         )
         (vla-erase x)
       )
       (vlax-invoke ob 'explode)
     ) ;mapcar
   ) ;repeat 
 ) ;and
 (vl-cmdf "_.UNDO" "_END")
 (princ)
)

Note that now you don't need (LM:defaultprops)...

HTH., M.R.

thank you for your help~

June 7, 2018

Marko_ribar

I know this was originally written by Lee Mac and I'm not trying to take that away from him I just modified to work for what I need it for but I need some help. If someone could help me I would appreciate it look at the comment in red.

(defun c:segoff ( / a b d e i l n p s v x y z )
   (initget 6)
   (if (and (setq d (getdist "\nSpecify offset: "))
            (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))))
   (setq num -1)
       )  
 (repeat (setq i (sslength s))
 (setq VlaObj (vlax-ename->vla-object (ssname s (setq num (1+ num)))))
 (vl-catch-all-apply 'vlax-put (list VlaObj 'Layer "LAYER NAME"))
           (setq i (1- i)
                 e (ssname s i)
                 x (entget e)
                 p (LM:defaultprops x)
                 z (list (cdr (assoc 38 x)))
                 l nil
           )
           (while (setq v (assoc 10 x))
               (setq l (cons (append (cdr v) z) l)
                     x (cdr (member v x))
               )
           )
           (setq n (/ pi (if (LM:listclockwise-p l) 2 -2)))
           (mapcar
              '(lambda ( x y / a b )
                   (setq a (+ (angle x y) n)
                         b (list x (polar x a d) (polar y a d) y)
                   )
                   (mapcar
                      '(lambda ( a b )
      (entmake (vl-list* '(0 . "LINE") (cons 10 (trans a e 0)) (cons 11 (trans b e 0)) p))
      (vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object (entlast)) 'Layer "LAYER NAME"))
       )
                       b (cdr b)
                  ) 
               )
               (cons (last l) l) l
           )
       )
   )
(setq obj (vl-catch-all-apply 'vlax-invoke (list VlaObj 'explode))) [color=red];;; I'm trying to figure out how to collect the lines this creates to use on the next step[/color]

(setq objLst(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex obj)))))
 (vla-StartUndoMark (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object))))
 (foreach ln objLst (vlax-put ln 'startpoint (polar (vlax-get ln 'startpoint)(vlax-get ln 'angle)(- d))))
 (foreach ln objLst (vlax-put ln 'endpoint (polar (vlax-get ln 'endpoint)(vlax-get ln 'angle)d)))
 (vla-EndUndoMark actDoc)

  (vl-catch-all-apply 'vla-delete (list VlaObj))
   (princ)
)
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
(defun LM:listclockwise-p ( lst )
   (minusp
       (apply '+
           (mapcar
               (function
                   (lambda ( a b )
                       (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                   )
               )
               lst (cons (last lst) lst)
           )
       )
   )
)
;; Default Properties  -  Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
(defun LM:defaultprops ( enx )
   (mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
      '(
           (006 . "BYLAYER")
           (008 . "TOP")
           (039 . 0.0)
           (048 . 1.0)
           (062 . 256)
           (370 . -1)
       )
   )
)
(princ)

Thanks,

Brian

June 7, 2018

@Brian,

To collect entities after vla-explode, I suggest that you use similar technique to this :

(setq el (entlast)) ; put this line just before vla-explode
... ; now your line with vla-exlpode
(while (setq el (entnext el))
 (if (not (wcmatch (cdr (assoc 0 (entget el))) "VERTEX,ATTRIB,SEQEND"))
   (setq ell (cons el ell))
 )
)
... ; you collected exploded entities in list "ell"
;;; now if you need sel. set...
(setq ss (ssadd))
(foreach e ell
 (ssadd e ss)
)
... ; you have those entities now in sel. set "ss"

Sign In

Hellow~ , Would you see this message. about this AutoLisp .

Recommended Posts

nest1291

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

ReMark

Lee Mac

ronjonp

Lee Mac

hanhphuc

nest1291

marko_ribar

BrianTFC

marko_ribar

nest1291

marko_ribar

BrianTFC

marko_ribar

hanhphuc

marko_ribar

nest1291

nest1291

BrianTFC

marko_ribar

Join the conversation

Tutorials

Forums

Activity