Jump to content

Offset after conversion from region to polyline.

Trap3d

By Trap3d
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Trap3d Explorer

Trap3d

Posted
Posted

Hello everyone,

 

I found this code on the internet that converts all regions i select into polylines. In the end of the code, i want the code to be able to agroup all polylines into one variable. The reason of that, i need to offset them all at once. Sometimes i need to do it hundreds of times.

I added the offset part in the end of the code. It works only on one polyline, because the variable "pline" has only the last polyline.

Can someone modify the code so it applies to all selection? I need to store all polylines in one variable.

You can try the code on the regions i have on the example i attached. 

(defun c:Region2Polyline2 nil
(if (setq ss (ssget '((0 . "REGION"))))
(:Region2Polyline2 ss))
(princ)
)

;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline2 (ss / *error* arcbugle acdoc space
n reg norm expl olst blst dlst plst tlst blg pline)

;-----
(defun *error* (msg)
(if (/= msg "Function cancelled")
(princ (strcat "\nError: " msg)))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))

;-----
(defun arcbulge (arc)
(/ (sin (/ (vla-get-TotalAngle arc) 4))
(cos (/ (vla-get-TotalAngle arc) 4))))

;-----
;-----

(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace acdoc)
(vla-get-ModelSpace acdoc)))
(if ss
(repeat (setq i (sslength ss))
(setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
norm (vlax-get reg 'Normal)
expl (vlax-invoke reg 'Explode))
(if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
(= (vla-get-ObjectName x) "AcDbArc")))
expl)
(progn
(vla-delete reg)
(setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
expl))
(while olst
(setq blst nil)
(if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
(setq blst (list (cons 0 (arcbulge (caar olst))))))
(setq plst (cdar olst)
dlst (list (caar olst))
olst (cdr olst))
(while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
(equal (last plst) (caddr x) 1e-9)))
olst))
(if (equal (last plst) (caddar tlst) 1e-9)
(setq blg -1)
(setq blg 1))
(if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
(setq blst (cons (cons (1- (length plst))
(* blg (arcbulge (caar tlst)))
)
blst)))
(setq plst (append plst
(if (minusp blg)
(list (cadar tlst))
(list (caddar tlst))))
dlst (cons (caar tlst) dlst)
olst (vl-remove (car tlst) olst)))
(setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x)
(setq x (trans x 0 Norm))
(list (car x) (cadr x)))
(reverse (cdr (reverse plst)))))))
(vla-put-Closed pline :vlax-true)
(mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
(vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
(vla-put-Normal pline (vlax-3d-point Norm))
(mapcar 'vla-delete dlst)))
(mapcar 'vla-delete expl)))
)
  ; Offset the polyline
  (if pline
    (progn
      (vla-StartUndoMark acdoc)  ; Start an undo mark
      (vla-get-ActiveDocument (vlax-get-acad-object))
      (vla-offset pline 0.8)  ; Offset the polyline by 0.3 units
      (vla-EndUndoMark acdoc)  ; End the undo mark
)
)
)


(C:Region2Polyline2)

 

 

 

LISP.dwg

  • Like 1
Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted (edited)

Right.

 

The polyline is created and put in a variable pline.  

 So I start the function by making an empty list (setq plines (list)).

 

Then after each pline is created I add pline to the list of plines.  (setq plines (append plines (list pline)))

Then at the end you can (foreach pline plines) to do whatever you want with all the polylines.

 

  


(defun c:Region2Polyline2 nil
	
	(if (setq ss (ssget '((0 . "REGION"))))
		(:Region2Polyline2 ss)
	)
	(princ)
)

	;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline2 (ss / *error* arcbugle acdoc space n reg norm expl olst blst dlst plst tlst blg pline plines)

	;-----
	(defun *error* (msg)
	(if (/= msg "Function cancelled")
	(princ (strcat "\nError: " msg)))
	(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
	(princ))

	;-----
	(defun arcbulge (arc)
	(/ (sin (/ (vla-get-TotalAngle arc) 4))
	(cos (/ (vla-get-TotalAngle arc) 4))))

	;-----
	;-----
	
	;; This will be the list of all the polylines created
	(setq plines (list))

	(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
	space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace acdoc)
	(vla-get-ModelSpace acdoc)))
	(if ss
		(repeat (setq i (sslength ss))
			(setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
				norm (vlax-get reg 'Normal)
				expl (vlax-invoke reg 'Explode)
			)
			(if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
				(= (vla-get-ObjectName x) "AcDbArc")))
				expl)
				(progn
					(vla-delete reg)
					(setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
					expl))
					(while olst
					(setq blst nil)
					(if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
					(setq blst (list (cons 0 (arcbulge (caar olst))))))
					(setq plst (cdar olst)
					dlst (list (caar olst))
					olst (cdr olst))
					(while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
					(equal (last plst) (caddr x) 1e-9)))
					olst))
					(if (equal (last plst) (caddar tlst) 1e-9)
					(setq blg -1)
					(setq blg 1))
					(if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
					(setq blst (cons (cons (1- (length plst))
					(* blg (arcbulge (caar tlst)))
					)
					blst)))
					(setq plst (append plst
					(if (minusp blg)
					(list (cadar tlst))
					(list (caddar tlst))))
					dlst (cons (caar tlst) dlst)
					olst (vl-remove (car tlst) olst)))
					(setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x)
						(setq x (trans x 0 Norm))
						(list (car x) (cadr x)))
						(reverse (cdr (reverse plst))))))
					)
					(vla-put-Closed pline :vlax-true)
					(mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
					(vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
					(vla-put-Normal pline (vlax-3d-point Norm))
					
					;; now let's put this pline in a list of plines. 
					(setq plines (append plines (list pline)))
					
					(mapcar 'vla-delete dlst))
				)
				;; else
				(mapcar 'vla-delete expl)
			)
		)
	)
	;; now offset all plines
	(foreach pline plines
		; Offset the polyline
		(if pline
			(progn
			  (vla-StartUndoMark acdoc)  ; Start an undo mark
			  (vla-get-ActiveDocument (vlax-get-acad-object))
			  (vla-offset pline 0.8)  ; Offset the polyline by 0.3 units
			  (vla-EndUndoMark acdoc)  ; End the undo mark
			)
		)
	)
)
 
(C:Region2Polyline2)

 

 

 

Edited by Emmanuel Delay
  • Like 2
  • Thanks 1
Link to comment
Share on other sites
  • 7 months later...
DELLA MAGGIORA YANN Contributor

DELLA MAGGIORA YANN

Posted
Posted

HI
SUPER LISP
I WOULD LIKE TO KNOW IF IT WAS POSSIBLE FOR THE REGION TO BE CONVERTED INTO A POLYLINE WITHOUT OFFSET, SIMPLY CONVERT THE SELECTED REGION INTO POLYLINE,
THANK YOU

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted
33 minutes ago, DELLA MAGGIORA YANN said:

HI
SUPER LISP
I WOULD LIKE TO KNOW IF IT WAS POSSIBLE FOR THE REGION TO BE CONVERTED INTO A POLYLINE WITHOUT OFFSET, SIMPLY CONVERT THE SELECTED REGION INTO POLYLINE,
THANK YOU

 

Have a look at the code, I am sure it is possible and am sure it is obvious. Perhaps search "Offset" - the reason I say this is that converting a line it is natural for it to be in the same location and offset is highly likely to be an additional bit of code than can be removed. 

 

Try it and see.

Link to comment
Share on other sites
DELLA MAGGIORA YANN Contributor

DELLA MAGGIORA YANN

Posted
Posted

I tried to delete what referred to the offset but without success, plus the lisp launches itself when opening each new drawing. I have to escape after opening a new drawing. But thanks for the advice anyway.

Link to comment
Share on other sites
pkenewell Proficient

pkenewell

Posted
Posted (edited)

@DELLA MAGGIORA YANN

 

Hint - comment out at the end of the routine using semi-colons like below: 

	;; now offset all plines
; 	(foreach pline plines
; 		; Offset the polyline
; 		(if pline
; 			(progn
; 			  (vla-StartUndoMark acdoc)  ; Start an undo mark
; 			  (vla-get-ActiveDocument (vlax-get-acad-object))
; 			  (vla-offset pline 0.8)  ; Offset the polyline by 0.3 units
; 			  (vla-EndUndoMark acdoc)  ; End the undo mark
; 			)
; 		)
; 	)

) ; DONT comment in front of this line
 
; (C:Region2Polyline2) comment in front of this line to stop it from running when loaded.

 

Note - it is considered rude among this forum to just ask for free help without attempting to learn at least some basics about AutoLISP / Visual LISP. Thanks why most here will try to guide you through rather then just updating it for you.

Edited by pkenewell
  • Like 1
Link to comment
Share on other sites
  • 2 months later...
XDSoft Contributor

XDSoft

Posted
Posted
On 6/25/2023 at 1:56 AM, Trap3d said:

Hello everyone,

 

I found this code on the internet that converts all regions i select into polylines. In the end of the code, i want the code to be able to agroup all polylines into one variable. The reason of that, i need to offset them all at once. Sometimes i need to do it hundreds of times.

I added the offset part in the end of the code. It works only on one polyline, because the variable "pline" has only the last polyline.

Can someone modify the code so it applies to all selection? I need to store all polylines in one variable.

You can try the code on the regions i have on the example i attached. 

(defun c:Region2Polyline2 nil
(if (setq ss (ssget '((0 . "REGION"))))
(:Region2Polyline2 ss))
(princ)
)

;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline2 (ss / *error* arcbugle acdoc space
n reg norm expl olst blst dlst plst tlst blg pline)

;-----
(defun *error* (msg)
(if (/= msg "Function cancelled")
(princ (strcat "\nError: " msg)))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))

;-----
(defun arcbulge (arc)
(/ (sin (/ (vla-get-TotalAngle arc) 4))
(cos (/ (vla-get-TotalAngle arc) 4))))

;-----
;-----

(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace acdoc)
(vla-get-ModelSpace acdoc)))
(if ss
(repeat (setq i (sslength ss))
(setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
norm (vlax-get reg 'Normal)
expl (vlax-invoke reg 'Explode))
(if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
(= (vla-get-ObjectName x) "AcDbArc")))
expl)
(progn
(vla-delete reg)
(setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
expl))
(while olst
(setq blst nil)
(if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
(setq blst (list (cons 0 (arcbulge (caar olst))))))
(setq plst (cdar olst)
dlst (list (caar olst))
olst (cdr olst))
(while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
(equal (last plst) (caddr x) 1e-9)))
olst))
(if (equal (last plst) (caddar tlst) 1e-9)
(setq blg -1)
(setq blg 1))
(if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
(setq blst (cons (cons (1- (length plst))
(* blg (arcbulge (caar tlst)))
)
blst)))
(setq plst (append plst
(if (minusp blg)
(list (cadar tlst))
(list (caddar tlst))))
dlst (cons (caar tlst) dlst)
olst (vl-remove (car tlst) olst)))
(setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x)
(setq x (trans x 0 Norm))
(list (car x) (cadr x)))
(reverse (cdr (reverse plst)))))))
(vla-put-Closed pline :vlax-true)
(mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
(vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
(vla-put-Normal pline (vlax-3d-point Norm))
(mapcar 'vla-delete dlst)))
(mapcar 'vla-delete expl)))
)
  ; Offset the polyline
  (if pline
    (progn
      (vla-StartUndoMark acdoc)  ; Start an undo mark
      (vla-get-ActiveDocument (vlax-get-acad-object))
      (vla-offset pline 0.8)  ; Offset the polyline by 0.3 units
      (vla-EndUndoMark acdoc)  ; End the undo mark
)
)
)


(C:Region2Polyline2)

 

 

 

LISP.dwg 37.05 kB · 7 downloads

 

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

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

I think I commented earlier, it would be far more convenient for us if you post the code in the same thread as the question was asked, rather than starting a new single post thread without any context in another forum.

  • Like 2
Link to comment
Share on other sites

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...