Lsp to Automatically put tabs on polyline

[claire2017]

Hi everyone,

 

I'm assuming this has to have been created somewhere to assist all those people that have to draw panels with tab returns on them, but short of buying a program i cant seem to find a solution!

I have a bunch of polylines, mostly rectangle shaped and not necessarily all with 90 degree corners that need 20mm returns on them with the corners cut out. I've found a lsp to extend the lines by 20mm but then they need to be joined. I've attached a picture of what i'm trying to achieve and also the double extend lisp if that's at all helpful.

 

 

 

DoubleExtendV1-0.lsp

[BIGAL]

A hint offset pline then notch corners, yes a lisp. Ignore image having trouble removing. Its a point square to another pline routine to do notch. Need to have a think. Happy to discuss any others you want as a fee for service.

 

 

Edited May 3, 2019 by BIGAL

[BIGAL]

TRy this if it errors on the last tab let me know I have spent an hour trying to find a hidden character in code or its my pc has a memory problem code works when I run last few lines from command line.

 

; take a pline and have offset tabs
; by Alan H May 2019

(defun ah:pltabs ( / x pt1 pt2 pt3 pt4 dist )
(setq ent (entsel "pick pline"))
(if (= (cdr(assoc 0  (entget (car ent)))) "LWPOLYLINE")
(progn
(setq co-ords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq x 0)
(setq lst '())
(repeat  (-(length  co-ords) 1)
(setq  pt1 (nth x co-ords))
(setq pt2 (nth (+ x 1) co-ords))
(setq lst (cons (angle pt1 pt2)lst))
(setq x (+ x 1))
)
(setq lst (cons (angle  (nth (-(length  co-ords) 1) co-ords)(nth 0 co-ords))lst))
)
)
(setq lst (reverse lst))
(setvar 'osmode 0)
(setq dist (getreal "Enter  tab size"))
(setq x 0)
(repeat(length lst)
(setq pt1 (nth x co-ords))
(setq pt2 (polar pt1  (+(nth x lst)(* 1.5 pi)) dist))
(command "Line" pt1 pt2 "")
(setq pt1 (nth (+ x 1) co-ords))
(setq pt3 (polar pt1 (+ (nth x lst)(* 1.5 pi)) dist))
(command "Line" pt1 pt3 "")
(command "Line" pt2  pt3 "")
(setq x (+ x 1))
)
(setq pt1 (nth x co-ords))
(setq pt2 (polar pt1  (+ (nth x lst) (* 1.5 pi)) dist))
(command "line" pt1 pt2 "")
(setq pt1 (nth 0 co-ords))
(setq pt3 (polar pt1 (- (nth x lst)(* 0.5 pi)) dist))
(command "line" pt1 pt3 "")
(command "line" pt2 pt3 "")
(princ)
)
( ah:pltabs)

Edited May 3, 2019 by BIGAL

[Roy_043]

@BIGAL

The problem is caused by the second repeat loop.

When x = (1- (length lst))

(setq pt1 (nth (+ x 1) co-ords))

will return nil.

 

[BIGAL]

Thanks roy when you look at it yourself can never see the problem. I was doing the last segment twice.

 

 

 

Edited May 3, 2019 by BIGAL

[claire2017]

Hey BigAl,

 

Thankyou so much!

 

Its doing exactly as you said, the last side isn't offsetting, i tried putting in the code from Roy but its not working & i don't understand what i'm doing wrong

 

Also the command 'pltabs' doesnt work. The only way i could test it was after installling it, it pops up once then i have to uninstall it and install it again to run the lisp again.

 

Please excuse my limited knowledge, its super frustrating for me too haha

 

Claire

 

 

 

 

[BIGAL]

Sorry I thought I edited the code this line is correct now (repeat (- (length lst) 1) just change in your saved version.

 

I tend to run my commands from menu's so change AH:pltabs to c:ahpltabs in the two locations it will run on 1st load then just type ahpltabs to run again. You can shorten it if you want.

 

; take a pline and have offset tabs
; by Alan H May 2019

(defun ah:pltabs ( / x pt1 pt2 pt3 pt4 dist )
(setq ent (entsel "pick pline"))
(if (= (cdr(assoc 0  (entget (car ent)))) "LWPOLYLINE")
(progn
(setq co-ords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq x 0)
(setq lst '())
(repeat  (-(length  co-ords) 1)
(setq  pt1 (nth x co-ords))
(setq pt2 (nth (+ x 1) co-ords))
(setq lst (cons (angle pt1 pt2)lst))
(setq x (+ x 1))
)
(setq lst (cons (angle  (nth (-(length  co-ords) 1) co-ords)(nth 0 co-ords))lst))
)
)
(setq lst (reverse lst))
(setvar 'osmode 0)
(setq dist (getreal "Enter  tab size"))
(setq x 0)
(repeat (- (length lst) 1)
(setq pt1 (nth x co-ords))
(setq pt2 (polar pt1  (+(nth x lst)(* 1.5 pi)) dist))
(command "Line" pt1 pt2 "")
(setq pt1 (nth (+ x 1) co-ords))
(setq pt3 (polar pt1 (+ (nth x lst)(* 1.5 pi)) dist))
(command "Line" pt1 pt3 "")
(command "Line" pt2  pt3 "")
(setq x (+ x 1))
)
(setq pt1 (nth x co-ords))
(setq pt2 (polar pt1  (+ (nth x lst) (* 1.5 pi)) dist))
(command "line" pt1 pt2 "")
(setq pt1 (nth 0 co-ords))
(setq pt3 (polar pt1 (- (nth x lst)(* 0.5 pi)) dist))
(command "line" pt1 pt3 "")
(command "line" pt2 pt3 "")
(princ)
)
( ah:pltabs)

 

[BIGAL]

It has taken about 4 goes to change the code above in my 1st code post any bodyelse have this problem this is why I am sure I changed previously.

[claire2017]

BigAL,

You are amazing!

Thankyou!!!

 

I don't suppose you could recommend a book, or set of tutorials on writing lsps? 

 

[BIGAL]

Go to kindle books there are 4 books available by Reinaldo Togores very cheap.

 

Also www.Afralisp has good tutorials.

 

 

[claire2017]

ok, thankyou

[DELLA MAGGIORA YANN]

Le 07/05/2019 à 08 :47, BIGAL a dit :

Désolé, je pensais avoir modifié le code, cette ligne est correcte maintenant (répétez (- (longueur lst) 1), changez simplement votre version enregistrée.

 

J’ai tendance à exécuter mes commandes à partir de menus, alors changez AH :pltabs en c :ahpltabs dans les deux emplacements, il s’exécutera au 1er chargement, puis tapez simplement ahpltabs pour l’exécuter à nouveau. Vous pouvez le raccourcir si vous le souhaitez.

 

; take a pline and have offset tabs
; by Alan H May 2019

(defun ah:pltabs ( / x pt1 pt2 pt3 pt4 dist )
(setq ent (entsel "pick pline"))
(if (= (cdr(assoc 0  (entget (car ent)))) "LWPOLYLINE")
(progn
(setq co-ords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq x 0)
(setq lst '())
(repeat  (-(length  co-ords) 1)
(setq  pt1 (nth x co-ords))
(setq pt2 (nth (+ x 1) co-ords))
(setq lst (cons (angle pt1 pt2)lst))
(setq x (+ x 1))
)
(setq lst (cons (angle  (nth (-(length  co-ords) 1) co-ords)(nth 0 co-ords))lst))
)
)
(setq lst (reverse lst))
(setvar 'osmode 0)
(setq dist (getreal "Enter  tab size"))
(setq x 0)
(repeat (- (length lst) 1)
(setq pt1 (nth x co-ords))
(setq pt2 (polar pt1  (+(nth x lst)(* 1.5 pi)) dist))
(command "Line" pt1 pt2 "")
(setq pt1 (nth (+ x 1) co-ords))
(setq pt3 (polar pt1 (+ (nth x lst)(* 1.5 pi)) dist))
(command "Line" pt1 pt3 "")
(command "Line" pt2  pt3 "")
(setq x (+ x 1))
)
(setq pt1 (nth x co-ords))
(setq pt2 (polar pt1  (+ (nth x lst) (* 1.5 pi)) dist))
(command "line" pt1 pt2 "")
(setq pt1 (nth 0 co-ords))
(setq pt3 (polar pt1 (- (nth x lst)(* 0.5 pi)) dist))
(command "line" pt1 pt3 "")
(command "line" pt2 pt3 "")
(princ)
)
( ah:pltabs)

 

Good morning
lisp very useful thank you
I have a small comment or two if you allow me...
does not work correctly if you make a rectangle from right to left with the rectangle command.
works very well in the other direction and with all the polygons that I have tried.
and could we erase the old polygon and join the lines to obtain a closed polygon according to you?

[BIGAL]

Pline problem is to do with wether its drawn Clockwise CW or Counter Clockwise CCW, so tabs will go in instead of out. 

 

Will fix code and repost. A easy fix.

 

See my post 2 will add the enter sizes dcl, are you metric or imperial.

[pkenewell]

@DELLA MAGGIORA YANN This sounded like a fun exercise so I wrote my own version. This one should account for the polyline direction and will match the layer of the selected polyline.

 

;; Written by PJK (pkenewell on theswamp.org) 3/13/2024
(defun c:pltabs ( / sub-AddLWPolyline sub-polydir a al d dir dist ent lyr pl)
   
   ;; Sub function to determine the direction of an LWPolyline.
   (defun sub-polydir (e / sub-Array->Ptlist sub-defang en et pl fl sum)

      ;; This sub function returns the deflection angle (in radians) of two angles:
      (defun sub-defang (a1 a2)
         (cond
            ((> a1 (+ a2 pi)) (setq a2 (+ a2 (* 2 pi))))
            ((> a2 (+ a1 pi)) (setq a1 (+ a1 (* 2 pi))))
         ) 
         (- a2 a1)
      );; end sub function.
   
      ;;this sub function converts an array into a point list.
      (defun sub-Array->Ptlist (ar d / vl rs)
         (setq vl (vlax-safearray->list (vlax-variant-value ar)))
         (if (eq d 2)
            (while vl (setq rs (cons (list (car vl) (cadr vl)) rs) vl (cddr vl)))
            (while vl (setq rs (cons (list (car vl) (cadr vl) (caddr vl)) rs) vl (cdddr vl)))
         )
         (reverse rs)
      );; End sub function.

      (setq pl (sub-Array->Ptlist (vla-get-coordinates (vlax-ename->vla-object e)) 2)
            en (entget e)
            fl (cdr (assoc 70 en))
            pl (if (and fl (= (logand 1 fl) 1))(reverse (cons (car pl) (reverse pl))))
            sum
               (apply '+
                  (mapcar
                     '(lambda (a b c)(sub-defang (angle a b) (angle b c)))
                      pl (cdr pl) (cdr (cdr pl))
                  )
               )
      )
      (if (minusp sum) "CW" "CCW")
   );; end sub-function

   ;; Sub function to draw an LWPolyline.
   (defun sub-AddLWPolyline (ptl lyr / doc lwp nml ptl ret spc)
      (setq doc (vla-get-activedocument (vlax-get-acad-object))
            lyr (if (and lyr (tblsearch "LAYER" lyr)) lyr (getvar "CLAYER"))
            spc (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
            nml (trans '(0 0 1) 1 0 T)
            ptl (mapcar '(lambda (x) (setq x (trans x 1 nml)) (list (car x)(cadr x))) ptl)
            ptl (apply  'append ptl)
      )
   	(setq lwp (vlax-invoke spc 'AddLightweightPolyline ptl))
   	(if lwp (vla-put-layer lwp lyr))
      lwp
   );; End sub-funtion
   
   (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object))))
   (if
      (and
         (setq ent (entsel "\nSelect a 2D Polyline: "))
         (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
      )
      (progn
         (setq pl  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))
               lyr (cdr (assoc 8 (entget (car ent))))
               dir (sub-polydir (car ent))
               al  (mapcar '(lambda (a b)(angle a b)) pl (append (cdr pl) (list (car pl))))
         )
         (if (setq dist (getreal "\nEnter the tab size: "))
            (mapcar
               '(lambda (a b c)
                   (sub-AddLWPolyline
                      (list
                         b
                         (polar b (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                         (polar c (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                         c
                      )
                      lyr
                   )
                )
                al
                pl
                (append (cdr pl) (list (car pl)))    
            )
            (princ "\nNo size entered. Exiting.")
         )
      )
      (princ "\nInvalid Selection. You must select a 2D Polyline.")
   )
   (vla-EndUndoMark d)       
   (princ)
)

 

Edited March 13 by pkenewell

[DELLA MAGGIORA YANN]

20 hours ago, pkenewell said:

@DELLA MAGGIORA YANN Cela semblait être un exercice amusant, alors j’ai écrit ma propre version. Celui-ci doit tenir compte de la direction de la polyligne et correspondra au calque de la polyligne sélectionnée.

 

;; Written by PJK (pkenewell on theswamp.org) 3/13/2024
(defun c:pltabs ( / sub-AddLWPolyline sub-polydir a al d dir dist ent lyr pl)
   
   ;; Sub function to determine the direction of an LWPolyline.
   (defun sub-polydir (e / sub-Array->Ptlist sub-defang en et pl fl sum)

      ;; This sub function returns the deflection angle (in radians) of two angles:
      (defun sub-defang (a1 a2)
         (cond
            ((> a1 (+ a2 pi)) (setq a2 (+ a2 (* 2 pi))))
            ((> a2 (+ a1 pi)) (setq a1 (+ a1 (* 2 pi))))
         ) 
         (- a2 a1)
      );; end sub function.
   
      ;;this sub function converts an array into a point list.
      (defun sub-Array->Ptlist (ar d / vl rs)
         (setq vl (vlax-safearray->list (vlax-variant-value ar)))
         (if (eq d 2)
            (while vl (setq rs (cons (list (car vl) (cadr vl)) rs) vl (cddr vl)))
            (while vl (setq rs (cons (list (car vl) (cadr vl) (caddr vl)) rs) vl (cdddr vl)))
         )
         (reverse rs)
      );; End sub function.

      (setq pl (sub-Array->Ptlist (vla-get-coordinates (vlax-ename->vla-object e)) 2)
            en (entget e)
            fl (cdr (assoc 70 en))
            pl (if (and fl (= (logand 1 fl) 1))(reverse (cons (car pl) (reverse pl))))
            sum
               (apply '+
                  (mapcar
                     '(lambda (a b c)(sub-defang (angle a b) (angle b c)))
                      pl (cdr pl) (cdr (cdr pl))
                  )
               )
      )
      (if (minusp sum) "CW" "CCW")
   );; end sub-function

   ;; Sub function to draw an LWPolyline.
   (defun sub-AddLWPolyline (ptl lyr / doc lwp nml ptl ret spc)
      (setq doc (vla-get-activedocument (vlax-get-acad-object))
            lyr (if (and lyr (tblsearch "LAYER" lyr)) lyr (getvar "CLAYER"))
            spc (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
            nml (trans '(0 0 1) 1 0 T)
            ptl (mapcar '(lambda (x) (setq x (trans x 1 nml)) (list (car x)(cadr x))) ptl)
            ptl (apply  'append ptl)
      )
   	(setq lwp (vlax-invoke spc 'AddLightweightPolyline ptl))
   	(if lwp (vla-put-layer lwp lyr))
      lwp
   );; End sub-funtion
   
   (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object))))
   (if
      (and
         (setq ent (entsel "\nSelect a 2D Polyline: "))
         (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
      )
      (progn
         (setq pl  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))
               lyr (cdr (assoc 8 (entget (car ent))))
               dir (sub-polydir (car ent))
               al  (mapcar '(lambda (a b)(angle a b)) pl (append (cdr pl) (list (car pl))))
         )
         (if (setq dist (getreal "\nEnter the tab size: "))
            (mapcar
               '(lambda (a b c)
                   (sub-AddLWPolyline
                      (list
                         b
                         (polar b (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                         (polar c (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                         c
                      )
                      lyr
                   )
                )
                al
                pl
                (append (cdr pl) (list (car pl)))    
            )
            (princ "\nNo size entered. Exiting.")
         )
      )
      (princ "\nInvalid Selection. You must select a 2D Polyline.")
   )
   (vla-EndUndoMark d)       
   (princ)
)

 

Great, it works well.
Is it possible to make the old rectangle or polygon be deleted or dotted in another layer for example and make the polylines created join to make a closed polyline?

[pkenewell]

1 hour ago, DELLA MAGGIORA YANN said:

Is it possible to make the old rectangle or polygon be deleted or dotted in another layer for example and make the polylines created join to make a closed polyline?

Yes - it's possible. Please explain more specifically what you would like to do:

1) Do you want to change the original Polyline or copy it (Keep the original)?

2) What layer and linetype do you want to use, or do you want to prompt for a new layer?

3) Do you mean that you want to join all the polylines for the tabs together? That is possible, but I don't know how you would join them to the original (if closed) polyline.

[DELLA MAGGIORA YANN]

9 hours ago, pkenewell said:

Oui, c’est possible. Veuillez expliquer plus précisément ce que vous aimeriez faire :

1) Voulez-vous changer la polyligne d’origine ou la copier (Conserver l’original) ?

2) Quel calque et quel type de ligne souhaitez-vous utiliser, ou souhaitez-vous demander un nouveau calque ?

3) Voulez-vous dire que vous voulez joindre toutes les polylignes des onglets ensemble ? C’est possible, mais je ne sais pas comment vous les joindriez à la polyligne d’origine (si elle est fermée).

Good morning
I will answer point by point for greater clarity.
1) I wanted the original polyline preserved or not (with a choice why not?)
2(If kept passed on a type of dotted line ( - - - - - - - -) and in a gray color slap.
3) Yes, join all tabs together
What would be fantastic would be to be able to choose the segments that will be shifted. Again with a choice of doing all the segments or one after the other.
let me explain...it would be for the creation of stair treads in folded sheets.
it would help me a lot in my job
This must all be quite complicated, I think.

[pkenewell]

11 hours ago, DELLA MAGGIORA YANN said:

Good morning
I will answer point by point for greater clarity.

@DELLA MAGGIORA YANN See the updated code below, which handles most of your needs, with the exception of selecting individual sides. I don't have enough time to work on that yet as it complicates the code much more than it already has been.

 

NOTE the section in the below code where you can adjust the Layer name, Linetype, color, and Linetype File to your preferences.

;; Written by PJK 3/13/2024
;; Updated 3/15/2024 to merge the tabs polyline, copy the original Polyline on new layer, and option to delete old polyline.

(defun c:pltabs ( / sub-AddLWPolyline sub-LoadLinetype sub-makelayer sub-polydir sub-SafeItem
                    a al d dir dist en LCOLOR LTFILE LTYPE lyr LYRNAME ob nb pl pl2)
   
   ;; Change to your preffered Layer Name and Linetype.
   ;;================================
   (setq LYRNAME "FoldLines" ;; Layer Name
         LTYPE   "DASHED"    ;; Line Type
         LCOLOR  254         ;; ACI Color Number
         LTFILE  "acad.lin"  ;; Line Type File (i.e. "ACAD.lin or ACADISO.lin)
   )
   ;;================================
   
   ;; Sub function to determine the direction of an LWPolyline.
   (defun sub-polydir (e / sub-Array->Ptlist sub-defang en et pl fl sum)

      ;; This sub function returns the deflection angle (in radians) of two angles:
      (defun sub-defang (a1 a2)
         (cond
            ((> a1 (+ a2 pi)) (setq a2 (+ a2 (* 2 pi))))
            ((> a2 (+ a1 pi)) (setq a1 (+ a1 (* 2 pi))))
         ) 
         (- a2 a1)
      );; end sub function.
   
      ;;this sub function converts an array into a point list.
      (defun sub-Array->Ptlist (ar d / vl rs)
         (setq vl (vlax-safearray->list (vlax-variant-value ar)))
         (if (eq d 2)
            (while vl (setq rs (cons (list (car vl) (cadr vl)) rs) vl (cddr vl)))
            (while vl (setq rs (cons (list (car vl) (cadr vl) (caddr vl)) rs) vl (cdddr vl)))
         )
         (reverse rs)
      );; End sub function.

      (setq pl (sub-Array->Ptlist (vla-get-coordinates (vlax-ename->vla-object e)) 2)
            en (entget e)
            fl (cdr (assoc 70 en))
            pl (if (and fl (= (logand 1 fl) 1))(reverse (cons (car pl) (reverse pl))))
            sum
               (apply '+
                  (mapcar
                     '(lambda (a b c)(sub-defang (angle a b) (angle b c)))
                      pl (cdr pl) (cdr (cdr pl))
                  )
               )
      )
      (if (minusp sum) "CW" "CCW")
   );; end sub-function

   ;; Sub function to retrieve an item from a collection if it exists.
   (defun sub-SafeItem (col item / res)
      (if
         (not
            (vl-catch-all-error-p
               (setq res (vl-catch-all-apply 'vla-item (list col item)))
            )
         )
         res
      )
   );; End sub function.
   
   ;;Sub function to create a new layer or edit existing layer.
   (defun sub-makelayer (ly cl lt fl / el rs st)

      (if (not lt) (setq lt "CONTINUOUS"))
   
      (if (not (tblsearch "LTYPE" lt))
         (sub-LoadLinetype lt (findfile LTFILE))
      )
   
      (if (not (tblsearch "LAYER" ly))
         (if (and
               (setq rs
                  (entmake
                     (list
                        (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
                        (cons 100 "AcDbLayerTableRecord")  (cons 2 ly)
                        (cons 70 0) (cons 62 (if cl cl 7)) (cons 6 lt)
                     )
                  )
               )
               fl
            )
            (setvar "clayer" ly)
         )
         (progn
            (setq el (entget (tblobjname "LAYER" ly))
                  el (subst (cons 62 (if cl cl 7)) (assoc 62 el) el)
                  el (subst (cons 6 lt) (assoc 6 el) el)
                  rs (entmod el)
                  st (cdr (assoc 70 el))
            )
            (if (= (logand st 1) 1)
               (if fl 
                  (progn
                     (setq el (subst (cons 70 (1- st)) (assoc 70 el) el)
                           rs  (entmod el)
                     )
                     (setvar "clayer" ly)
                  )
               )
               (if fl (setvar "clayer" ly))
            )
         )
      )
      (if rs ly nil)
   );; End sub function.
   
   ;; Sub function to load a linetype.
   (defun sub-LoadLinetype (nam ltfil / doc ltypes ret)
      (setq doc    (vla-get-activedocument (vlax-get-acad-object))
            ltypes (vla-get-linetypes doc)
      )
      (or (setq ret (sub-SafeItem ltypes nam))
          (progn
             (vla-load ltypes nam ltfil)
             (setq ret (sub-SafeItem ltypes nam))
          )
      )
      (setq nam (if ret (vla-get-name ret) nil))
   )
   
   ;; Sub function to draw an LWPolyline.
   (defun sub-AddLWPolyline (ptl lyr / doc lwp nml ptl ret spc)
      (setq doc (vla-get-activedocument (vlax-get-acad-object))
            lyr (if (and lyr (tblsearch "LAYER" lyr)) lyr (getvar "CLAYER"))
            spc (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
            nml (trans  '(0 0 1) 1 0 T)
            ptl (mapcar '(lambda (x) (setq x (trans x 1 nml)) (list (car x)(cadr x))) ptl)
            ptl (apply  'append ptl)
      )
      (setq lwp (vlax-invoke spc 'AddLightweightPolyline ptl))
      (if lwp (vla-put-layer lwp lyr))
      lwp
   );; End sub-funtion
   
   (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object))))
   (if
      (and
         (setq en (entsel "\nSelect a 2D Polyline: "))
         (= (cdr (assoc 0 (entget (car en)))) "LWPOLYLINE")
      )
      (if (setq dist (getreal "\nEnter the tab size: "))
         (progn
            (sub-makelayer LYRNAME LCOLOR LTYPE nil)
            (setq el  (entget (car en))
                  ob  (vlax-ename->vla-object (car en))
                  nb  (vla-copy ob)
                  pl  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) el))
                  lyr (cdr (assoc 8 el))
                  dir (sub-polydir (car en))
                  al  (mapcar '(lambda (a b)(angle a b)) pl (append (cdr pl) (list (car pl))))
            )
            (if nb (vla-put-layer nb LYRNAME))
            (initget "Yes No")
            (if (or (= (setq yn (getkword "\nDelete Original Polyline [Yes/No}? <Yes>")) "Yes") (not yn))
               (vla-delete ob)
            )
            (setq pl2
               (apply 'append
                  (mapcar
                     '(lambda (a b c)
                         (list
                            b
                            (polar b (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                            (polar c (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                            c
                         )
                      )
                      al
                      pl
                      (append (cdr pl) (list (car pl)))    
                  )
               )
            )
            (sub-AddLWPolyline pl2 lyr)
         )
         (princ "\nNo size entered. Exiting.")
      )
      (princ "\nInvalid Selection. You must select a 2D Polyline.")
   )
   (vla-EndUndoMark d)       
   (princ)
)

 

Edited March 15 by pkenewell

[BIGAL]

Pick a side only easiest is make it a new option. You can get a pline segment so work out the start and end points of that segment, will try to find. 

 

Sorry not sure who write this.

 

(defun getplineseg ( / elst ename pt param preparam postparam)
(setq elst (entsel "\nSelect pline segment: "))
(setq ename (car elst))
(setq pt (cadr elst))
(setq pt (vlax-curve-getClosestPointTo ename pt))
(print (setq param (vlax-curve-getParamAtPoint ename pt)) )
(print (setq preparam (fix param)) )
(print (setq postparam (1+ preparam)) )
(setq pt1 (vlax-curve-getPointAtParam ename preparam)
pt2 (vlax-curve-getPointAtParam ename postparam))
)

Probably break the existing pline and add the dashed line.

Edited March 16 by BIGAL

[DELLA MAGGIORA YANN]

On 3/15/2024 at 5:39 PM, pkenewell said:

@DELLA MAGGIORA YANN Consultez le code mis à jour ci-dessous, qui répond à la plupart de vos besoins, à l’exception de la sélection de côtés individuels. Je n’ai pas encore assez de temps pour travailler là-dessus car cela complique le code beaucoup plus qu’il ne l’a déjà été.

 

REMARQUE la section du code ci-dessous où vous pouvez ajuster le nom du calque, le type de ligne, la couleur et le fichier de type de ligne selon vos préférences.

;; Written by PJK 3/13/2024
;; Updated 3/15/2024 to merge the tabs polyline, copy the original Polyline on new layer, and option to delete old polyline.

(defun c:pltabs ( / sub-AddLWPolyline sub-LoadLinetype sub-makelayer sub-polydir sub-SafeItem
                    a al d dir dist en LCOLOR LTFILE LTYPE lyr LYRNAME ob nb pl pl2)
   
   ;; Change to your preffered Layer Name and Linetype.
   ;;================================
   (setq LYRNAME "FoldLines" ;; Layer Name
         LTYPE   "DASHED"    ;; Line Type
         LCOLOR  254         ;; ACI Color Number
         LTFILE  "acad.lin"  ;; Line Type File (i.e. "ACAD.lin or ACADISO.lin)
   )
   ;;================================
   
   ;; Sub function to determine the direction of an LWPolyline.
   (defun sub-polydir (e / sub-Array->Ptlist sub-defang en et pl fl sum)

      ;; This sub function returns the deflection angle (in radians) of two angles:
      (defun sub-defang (a1 a2)
         (cond
            ((> a1 (+ a2 pi)) (setq a2 (+ a2 (* 2 pi))))
            ((> a2 (+ a1 pi)) (setq a1 (+ a1 (* 2 pi))))
         ) 
         (- a2 a1)
      );; end sub function.
   
      ;;this sub function converts an array into a point list.
      (defun sub-Array->Ptlist (ar d / vl rs)
         (setq vl (vlax-safearray->list (vlax-variant-value ar)))
         (if (eq d 2)
            (while vl (setq rs (cons (list (car vl) (cadr vl)) rs) vl (cddr vl)))
            (while vl (setq rs (cons (list (car vl) (cadr vl) (caddr vl)) rs) vl (cdddr vl)))
         )
         (reverse rs)
      );; End sub function.

      (setq pl (sub-Array->Ptlist (vla-get-coordinates (vlax-ename->vla-object e)) 2)
            en (entget e)
            fl (cdr (assoc 70 en))
            pl (if (and fl (= (logand 1 fl) 1))(reverse (cons (car pl) (reverse pl))))
            sum
               (apply '+
                  (mapcar
                     '(lambda (a b c)(sub-defang (angle a b) (angle b c)))
                      pl (cdr pl) (cdr (cdr pl))
                  )
               )
      )
      (if (minusp sum) "CW" "CCW")
   );; end sub-function

   ;; Sub function to retrieve an item from a collection if it exists.
   (defun sub-SafeItem (col item / res)
      (if
         (not
            (vl-catch-all-error-p
               (setq res (vl-catch-all-apply 'vla-item (list col item)))
            )
         )
         res
      )
   );; End sub function.
   
   ;;Sub function to create a new layer or edit existing layer.
   (defun sub-makelayer (ly cl lt fl / el rs st)

      (if (not lt) (setq lt "CONTINUOUS"))
   
      (if (not (tblsearch "LTYPE" lt))
         (sub-LoadLinetype lt (findfile LTFILE))
      )
   
      (if (not (tblsearch "LAYER" ly))
         (if (and
               (setq rs
                  (entmake
                     (list
                        (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
                        (cons 100 "AcDbLayerTableRecord")  (cons 2 ly)
                        (cons 70 0) (cons 62 (if cl cl 7)) (cons 6 lt)
                     )
                  )
               )
               fl
            )
            (setvar "clayer" ly)
         )
         (progn
            (setq el (entget (tblobjname "LAYER" ly))
                  el (subst (cons 62 (if cl cl 7)) (assoc 62 el) el)
                  el (subst (cons 6 lt) (assoc 6 el) el)
                  rs (entmod el)
                  st (cdr (assoc 70 el))
            )
            (if (= (logand st 1) 1)
               (if fl 
                  (progn
                     (setq el (subst (cons 70 (1- st)) (assoc 70 el) el)
                           rs  (entmod el)
                     )
                     (setvar "clayer" ly)
                  )
               )
               (if fl (setvar "clayer" ly))
            )
         )
      )
      (if rs ly nil)
   );; End sub function.
   
   ;; Sub function to load a linetype.
   (defun sub-LoadLinetype (nam ltfil / doc ltypes ret)
      (setq doc    (vla-get-activedocument (vlax-get-acad-object))
            ltypes (vla-get-linetypes doc)
      )
      (or (setq ret (sub-SafeItem ltypes nam))
          (progn
             (vla-load ltypes nam ltfil)
             (setq ret (sub-SafeItem ltypes nam))
          )
      )
      (setq nam (if ret (vla-get-name ret) nil))
   )
   
   ;; Sub function to draw an LWPolyline.
   (defun sub-AddLWPolyline (ptl lyr / doc lwp nml ptl ret spc)
      (setq doc (vla-get-activedocument (vlax-get-acad-object))
            lyr (if (and lyr (tblsearch "LAYER" lyr)) lyr (getvar "CLAYER"))
            spc (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
            nml (trans  '(0 0 1) 1 0 T)
            ptl (mapcar '(lambda (x) (setq x (trans x 1 nml)) (list (car x)(cadr x))) ptl)
            ptl (apply  'append ptl)
      )
      (setq lwp (vlax-invoke spc 'AddLightweightPolyline ptl))
      (if lwp (vla-put-layer lwp lyr))
      lwp
   );; End sub-funtion
   
   (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object))))
   (if
      (and
         (setq en (entsel "\nSelect a 2D Polyline: "))
         (= (cdr (assoc 0 (entget (car en)))) "LWPOLYLINE")
      )
      (if (setq dist (getreal "\nEnter the tab size: "))
         (progn
            (sub-makelayer LYRNAME LCOLOR LTYPE nil)
            (setq el  (entget (car en))
                  ob  (vlax-ename->vla-object (car en))
                  nb  (vla-copy ob)
                  pl  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) el))
                  lyr (cdr (assoc 8 el))
                  dir (sub-polydir (car en))
                  al  (mapcar '(lambda (a b)(angle a b)) pl (append (cdr pl) (list (car pl))))
            )
            (if nb (vla-put-layer nb LYRNAME))
            (initget "Yes No")
            (if (or (= (setq yn (getkword "\nDelete Original Polyline [Yes/No}? <Yes>")) "Yes") (not yn))
               (vla-delete ob)
            )
            (setq pl2
               (apply 'append
                  (mapcar
                     '(lambda (a b c)
                         (list
                            b
                            (polar b (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                            (polar c (if (= dir "CCW")(+ a (* 1.5 pi))(- a (* 1.5 pi))) dist)
                            c
                         )
                      )
                      al
                      pl
                      (append (cdr pl) (list (car pl)))    
                  )
               )
            )
            (sub-AddLWPolyline pl2 lyr)
         )
         (princ "\nNo size entered. Exiting.")
      )
      (princ "\nInvalid Selection. You must select a 2D Polyline.")
   )
   (vla-EndUndoMark d)       
   (princ)
)

 

it's great, it meets 98% of my needs, it's already very good
Thank you very much, it will save me a lot of time.
If you managed to do it individually that would be perfect.
you are a genius