Jump to content

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

nest1291

By nest1291
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

hanhphuc Mentor

hanhphuc

Posted
Posted
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 )
...
...
...
(setq [color="red"]obj [/color](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 [color="red"]obj[/color]))))) 

...
...

 

 

hi, IMO Lee's code is fine. not sure what's your idea ?

 

 

[color="green"];;ignore this line [/color]
;;; (setq objLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex obj)))))[color="red"] ; <-- error ; (ssnamex ss ) selection set , not vla-object [/color]

[color="green"];;This is sufficient[/color]
(setq [color="red"][b]objLst[/b] [/color](vl-catch-all-apply 'vlax-invoke (list VlaObj 'explode))) [color="green"];;; vla-explode will returns a list [/color]

 

@Marko - try testing revision cloud it offsets inside.

  • Replies 26
  • Created
  • Last Reply

Top Posters In This Topic

  • marko_ribar

    8

  • nest1291

    7

  • BrianTFC

    4

  • hanhphuc

    4

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

BrianTFC Community Regular

BrianTFC

Posted
Posted

Thanks guys for your input. Hanhphuc's idea worked perfectly as soon as I erased that line it extended my line to the end of the outside blue line like I needed. thanks again.

nest1291 Explorer

nest1291

Posted
  • Author
Posted
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.

 

hi ~ thank you for your help.

 

i have one more question ~

 

i use this lisp . very good. changed layer thannk. you.

 

but after it worked . it makes double line outside.

 

How can i fix it ?

marko_ribar Veteran

marko_ribar

Posted
Posted

Thanks for checking, I haven't noticed it... Try this quick fix :

;; 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 "")
                          )
                        )[color=red]
                        (if (eq f (eval (read (strcat "vlax-curve-getendpoint"))))
                          (vla-erase (car o))
                        )[/color]
           )
           '("startpoint" "endpoint")
         )
         (vla-erase x)
       )
       (vlax-invoke ob 'explode)
     ) ;mapcar
   ) ;repeat 
 ) ;and
 (vl-cmdf "_.UNDO" "_END")
 (princ)
)

nest1291 Explorer

nest1291

Posted
  • Author
Posted
Thanks for checking, I haven't noticed it... Try this quick fix :

;; 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 "")
                          )
                        )[color=red]
                        (if (eq f (eval (read (strcat "vlax-curve-getendpoint"))))
                          (vla-erase (car o))
                        )[/color]
           )
           '("startpoint" "endpoint")
         )
         (vla-erase x)
       )
       (vlax-invoke ob 'explode)
     ) ;mapcar
   ) ;repeat 
 ) ;and
 (vl-cmdf "_.UNDO" "_END")
 (princ)
)

 

Thank you very much !!!!!!!!!!!!!!! very useful. to me. . thank you~

marko_ribar Veteran

marko_ribar

Posted
Posted

BTW. You have to apply this fix to all hanhphuc's versions...

 

 

M.R.

hanhphuc Mentor

hanhphuc

Posted
Posted
BTW. You have to apply this fix to all hanhphuc's versions...

 

 

M.R.

 

Thanks. Marko for the fix :)

(if (eq f vlax-curve-getendpoint))))
           (vla-erase (car o))

 

v1.1 known bugs :ouch:

1.S-shape curve

2.reversed revision cloud

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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.

×
 Share
Go to topic listing
×
×
  • Create New...