Lsp to Automatically put tabs on polyline

[BIGAL]

Try this for 1 at a time changes say opposite sides, note if do more than say opposite may do wrong direction.

 

; make plines tabs 1 at a time for a closed pline
; By AlanH March 2024

(defun c:pltabs2 ( / elst ename pt param preparam postparam pt1 pt2 pt3 pt4 obj CWCCW dist distans oldsnap)

(defun CWCCW (plent / plobj a1 a2)
(setq plobj (vlax-ename->vla-object plent))
(setq a1 (vlax-get plobj 'area))
(vla-offset plobj 10)
(setq a2 (vlax-get (vlax-ename->vla-object (entlast)) 'area ))
(command "erase" (entlast) "")
(if (< a2 a1)
 (princ "ok")
 (command "pedit" plent "R" "")
)
(command "regen")
(vlax-release-object plobj)
(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; starts here

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(if (= dist nil)(setq dist 10))

(setq distans (getstring (strcat "\nEnter the tab size: " (rtos dist 2 1) "  " )))

(if (= distans "")
(princ) ;skips changing dist
(setq dist (atof distans))
)

(while (and (setq ent (entsel "\nSelect pline segment press Enter to exit : "))
            (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ent)))))
        )
		
(CWCCW (car ent) )

(setq obj (vlax-ename->vla-object (car ent)))
(setq pt (cadr ent))
(setq lay (vlax-get obj 'Layer))
(setq pt (vlax-curve-getClosestPointTo obj pt))
(setq param (vlax-curve-getParamAtPoint obj pt))
(setq preparam (fix param))
(setq postparam (1+ preparam))
(setq pt1 (vlax-curve-getPointAtParam obj preparam)
      pt2 (vlax-curve-getPointAtParam obj postparam)
)
; thanks to Lee mac for trim
(command "_.trim" ent "" ent "")
(command "Line" pt1 pt2 "")

(setq obj (vlax-ename->vla-object (entlast)))
(vlax-put obj 'Layer lay)
(vlax-put obj 'Linetype "Dashed")
(vlax-put obj 'Linetypescale 100) ; change as required

(setq pt3 (polar pt2 (+ (angle pt1 pt2) (/ pi 2.)) dist))
(setq pt4 (polar pt1 (+ (angle pt1 pt2) (/ pi 2.)) dist))
(command "pline" pt1 pt4 pt3 pt2 "")

(setq obj (vlax-ename->vla-object (entlast)))
(vlax-put obj 'Layer lay)
(setq pt1 nil pt2 nil)
)

(setvar 'osmode oldsnap)
(princ)

)

 

[DELLA MAGGIORA YANN]

3 hours ago, BIGAL said:

Essayez ceci pendant 1 à la fois, les changements disent les côtés opposés, notez si vous faites plus que dire que l’opposé peut faire une mauvaise direction.

 

; make plines tabs 1 at a time for a closed pline
; By AlanH March 2024

(defun c:pltabs2 ( / elst ename pt param preparam postparam pt1 pt2 pt3 pt4 obj CWCCW dist distans oldsnap)

(defun CWCCW (plent / plobj a1 a2)
(setq plobj (vlax-ename->vla-object plent))
(setq a1 (vlax-get plobj 'area))
(vla-offset plobj 10)
(setq a2 (vlax-get (vlax-ename->vla-object (entlast)) 'area ))
(command "erase" (entlast) "")
(if (< a2 a1)
 (princ "ok")
 (command "pedit" plent "R" "")
)
(command "regen")
(vlax-release-object plobj)
(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; starts here

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(if (= dist nil)(setq dist 10))

(setq distans (getstring (strcat "\nEnter the tab size: " (rtos dist 2 1) "  " )))

(if (= distans "")
(princ) ;skips changing dist
(setq dist (atof distans))
)

(while (and (setq ent (entsel "\nSelect pline segment press Enter to exit : "))
            (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ent)))))
        )
		
(CWCCW (car ent) )

(setq obj (vlax-ename->vla-object (car ent)))
(setq pt (cadr ent))
(setq lay (vlax-get obj 'Layer))
(setq pt (vlax-curve-getClosestPointTo obj pt))
(setq param (vlax-curve-getParamAtPoint obj pt))
(setq preparam (fix param))
(setq postparam (1+ preparam))
(setq pt1 (vlax-curve-getPointAtParam obj preparam)
      pt2 (vlax-curve-getPointAtParam obj postparam)
)
; thanks to Lee mac for trim
(command "_.trim" ent "" ent "")
(command "Line" pt1 pt2 "")

(setq obj (vlax-ename->vla-object (entlast)))
(vlax-put obj 'Layer lay)
(vlax-put obj 'Linetype "Dashed")
(vlax-put obj 'Linetypescale 100) ; change as required

(setq pt3 (polar pt2 (+ (angle pt1 pt2) (/ pi 2.)) dist))
(setq pt4 (polar pt1 (+ (angle pt1 pt2) (/ pi 2.)) dist))
(command "pline" pt1 pt4 pt3 pt2 "")

(setq obj (vlax-ename->vla-object (entlast)))
(vlax-put obj 'Layer lay)
(setq pt1 nil pt2 nil)
)

(setvar 'osmode oldsnap)
(princ)

)

 

wow
It works very well, super lisp too
in the case where we wish to offset a simple polyline alone, could we choose the side where the offset is made?
otherwise in a closed polyline it works well
thanks

[DELLA MAGGIORA YANN]

7 hours ago, BIGAL said:

Essayez ceci pendant 1 à la fois, les changements disent les côtés opposés, notez si vous faites plus que dire que l’opposé peut faire une mauvaise direction.

 

; make plines tabs 1 at a time for a closed pline
; By AlanH March 2024

(defun c:pltabs2 ( / elst ename pt param preparam postparam pt1 pt2 pt3 pt4 obj CWCCW dist distans oldsnap)

(defun CWCCW (plent / plobj a1 a2)
(setq plobj (vlax-ename->vla-object plent))
(setq a1 (vlax-get plobj 'area))
(vla-offset plobj 10)
(setq a2 (vlax-get (vlax-ename->vla-object (entlast)) 'area ))
(command "erase" (entlast) "")
(if (< a2 a1)
 (princ "ok")
 (command "pedit" plent "R" "")
)
(command "regen")
(vlax-release-object plobj)
(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; starts here

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(if (= dist nil)(setq dist 10))

(setq distans (getstring (strcat "\nEnter the tab size: " (rtos dist 2 1) "  " )))

(if (= distans "")
(princ) ;skips changing dist
(setq dist (atof distans))
)

(while (and (setq ent (entsel "\nSelect pline segment press Enter to exit : "))
            (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ent)))))
        )
		
(CWCCW (car ent) )

(setq obj (vlax-ename->vla-object (car ent)))
(setq pt (cadr ent))
(setq lay (vlax-get obj 'Layer))
(setq pt (vlax-curve-getClosestPointTo obj pt))
(setq param (vlax-curve-getParamAtPoint obj pt))
(setq preparam (fix param))
(setq postparam (1+ preparam))
(setq pt1 (vlax-curve-getPointAtParam obj preparam)
      pt2 (vlax-curve-getPointAtParam obj postparam)
)
; thanks to Lee mac for trim
(command "_.trim" ent "" ent "")
(command "Line" pt1 pt2 "")

(setq obj (vlax-ename->vla-object (entlast)))
(vlax-put obj 'Layer lay)
(vlax-put obj 'Linetype "Dashed")
(vlax-put obj 'Linetypescale 100) ; change as required

(setq pt3 (polar pt2 (+ (angle pt1 pt2) (/ pi 2.)) dist))
(setq pt4 (polar pt1 (+ (angle pt1 pt2) (/ pi 2.)) dist))
(command "pline" pt1 pt4 pt3 pt2 "")

(setq obj (vlax-ename->vla-object (entlast)))
(vlax-put obj 'Layer lay)
(setq pt1 nil pt2 nil)
)

(setvar 'osmode oldsnap)
(princ)

)

 

Do you believe it is possible to create the same lisp with the creation of a closed boundary ?

[BIGAL]

Change this and will be closed.

(command "pline" pt1 pt4 pt3 pt2 "C")

Remove
(command "line" pt1 pt2 "") so no extra line

remove so no dashed line
(vlax-put obj 'Linetype "Dashed")
(vlax-put obj 'Linetypescale 100) ; change as required

 

 

 

[XDSoft]

 

https://www.theswamp.org/index.php?topic=59437.0

 

(defun c:tt (/ box edges height pts ss x y)
  (xd::doc:getdouble (xdrx-string-multilanguage "\n矩形高度：" "\nRectang Height:")
		     "#xd-var-global-rectang-height" (setq height (xd::doc:getpickboxheight))
  )
  (if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择封闭的多段线<退出>:"
						      "\nSelect Closed Polyline<Exit>:"
			   ) '((0 . "*POLYLINE") (-4 . "&=")
			    (70 . 1)
			   )
	       )
      )
    (progn
      (mapcar
	'(lambda (x)
	   (if (xdrx_curve_direction x)
	     (xdrx-curve-reverse x)
	   )
	   (setq edges (xdrx-getpropertyvalue x "AllLineSegs")
		 pts (xdrx-getpropertyvalue edges "vertices")
	   )
	   (mapcar
	     '(lambda (y)
		(setq box (xdrx-points->box y 0.0 #xd-var-global-rectang-height 0.0 0.0))
		(xdrx-polyline-make box t)
	      )
	     pts
	   )
	 )
	(xdrx-ss->ents ss)
      )
      (xdrx-draworder->top ss)
    )
  )
  (princ)
)

 

Edited April 9 by XDSoft