Leaderboard

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

@Steven P You could modify your selection set filter like so to weed out bad items (setq myss (ssget '((0 . "TEXT") (1 . "*# ?? #*"))))

@Nikon Why not just used the (vla-open) Method? ;; OPENDWG ;; Argument: dwg = string; the full path and file name of the drawing, or just the file name if in the search path. (defun opendwg (dwg) (vl-load-com) (vla-open (vla-get-documents (vlax-get-acad-object)) dwg) ) ;;Test (opendwg "C:\\Users\\Username\\Drawings24\\Office3.dwg")

@Steven P Thank you sir it’s work fine

@Nikon You have something unnecessary in there: you manually set the string with the drawing file with a "\\" on the end, which would be invalid for a drawing file path, then strip it off using (vl-string-right-trim)? (startapp "explorer" (strcat "/e,\"" (vl-string-right-trim "\\" "C:\\Users\\Username\\Drawings24\\Office3.dwg\\") "\"")) ;; Could be just this: (startapp "explorer" (strcat "/e,\"" "C:\\Users\\Username\\Drawings24\\Office3.dwg" "\"")) ;; in fact, you don't even need (strcat) if the path is hard-coded: (startapp "explorer" "/e,\"C:\\Users\\Username\\Drawings24\\Office3.dwg\"") Am I missing something?

(defun c:pp() (setq ss (ssget '((0 . "TEXT")))) (repeat (setq i (sslength ss)) (setq el (entget (ssname ss (setq i (1- i)))) txt1 (cdr (assoc 1 el))) (setq posX (vl-string-search " X " txt1) txt2 (strcat (substr txt1 (+ posX 3)) " X " (substr txt1 1 posX))) (setq el (subst (cons 1 txt2) (assoc 1 el) el)) (entmod el) ) ) Does this work for you? You can select all the texts to be changed and process them in one run.

vla thing? forgot to add (vl-load-com) before, you need that too, its for using ActiveX methods, read more here: https://help.autodesk.com/view/ACDLT/2024/ENU/?guid=GUID-A0459510-CE7A-4206-9EAA-E25AAB569B20 And if you want to understand more you can google and read about each vla function used (vla-open, vla-activate,...) I use this way of opening drawing by lisp when needed, but I'm sure there are other ways I'd suggest using this method because its faster than opening folder and then opening drawing manually, but its up to you

Put it where PATH HERE is (setq fname (getfiled "Select dwg File" "PATH HERE" "dwg" 16)) (getvar 'dwgprefix) is if you want to open folder where the current drawing in which you are calling lisp is Then open the drawing using this (vla-activate (vla-open (vla-get-documents (vlax-get-acad-object)) fname))

Why not just use Getfile you can set a start location like current dwg path, then just use (command "Open" fname). (setq fname (getfiled "Select dwg File" "" "dwg" 16)) (setq fname (getfiled "Select DWG File" (getvar 'dwgprefix) "dwg" 16))

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)

(vl-load-com) (defun c:TEXTEXPORT( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat) ; Sub-function - 01 (defun PTE:sortobj ( olst typ tol / typ objs opt npt lst data lst rev sx sy dxf x y PTE:s1 PTE:s2 PTE:s3 PTE:s4 ) (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls)) (defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b))))) (defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b))))) (defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o))))) (defun x (o) (car (dxf o 10))) (defun y (o) (cadr (dxf o 10))) (setq typ (vl-string->list (strcase typ))) (if (member (car typ) '(76 82)) (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev) (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev) ) (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs))) (foreach o objs (if (< tol (abs (- (setq npt (PTE:s2 o)) opt))) (setq lst (cons data lst) data (list o) opt npt) (setq data (cons o data)) ) ) (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst)) lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst) ) ) ; Sub-function - 02 (defun LM:UnFormat ( str mtx / _Replace regex ) ;; ⓒ Lee Mac 2010 (defun _Replace ( new old str ) (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new) ) (setq regex (vlax-get-or-create-object "VBScript.RegExp")) (mapcar (function (lambda ( x ) (vlax-put-property regex (car x) (cdr x))) ) (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) ) (mapcar (function (lambda ( x ) (setq str (_Replace (car x) (cdr x) str))) ) '( ("Ð" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) ) (setq str (if mtx (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_Replace "\\" "Ð" str) ) ) (vlax-release-object regex) str ) ;================================================================================== ; Main function ;================================================================================== (ssget '((0 . "text,mtext"))) (setq doc (vla-get-activedocument (vlax-get-acad-object)) objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs))) tol (car (vl-sort (mapcar 'vla-get-height objs) '<)) objs (PTE:sortobj objs "rdr" tol) ) (or (setq excel(vlax-get-or-create-object "Excel.Application")) (alert "Fail to Excel load") (exit) ) (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add) (vlax-put Excel 'visible :vlax-true) (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells) x 1 y 1 ) (foreach os objs (foreach o os (setq str (if (= (vla-get-objectname o) "AcDbText") (vla-get-textstring o) (LM:UnFormat (vla-get-textstring o) nil) ) ) (vlax-put-property cell 'item y x (strcat "'" str)) (setq x (1+ x)) ) (setq y (1+ y) x 1) )(princ) ) (defun c:TEXTEXPORTINCOLUMN( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat) ; Sub-function - 01 (defun PTE:sortobj ( olst typ tol / typ objs opt npt lst data lst rev sx sy dxf x y PTE:s1 PTE:s2 PTE:s3 PTE:s4 ) (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls)) (defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b))))) (defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b))))) (defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o))))) (defun x (o) (car (dxf o 10))) (defun y (o) (cadr (dxf o 10))) (setq typ (vl-string->list (strcase typ))) (if (member (car typ) '(76 82)) (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev) (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev) ) (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs))) (foreach o objs (if (< tol (abs (- (setq npt (PTE:s2 o)) opt))) (setq lst (cons data lst) data (list o) opt npt) (setq data (cons o data)) ) ) (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst)) lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst) ) ) ; Sub-function - 02 (defun LM:UnFormat ( str mtx / _Replace regex ) ;; ⓒ Lee Mac 2010 (defun _Replace ( new old str ) (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new) ) (setq regex (vlax-get-or-create-object "VBScript.RegExp")) (mapcar (function (lambda ( x ) (vlax-put-property regex (car x) (cdr x))) ) (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) ) (mapcar (function (lambda ( x ) (setq str (_Replace (car x) (cdr x) str))) ) '( ("Ð" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) ) (setq str (if mtx (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_Replace "\\" "Ð" str) ) ) (vlax-release-object regex) str ) ;================================================================================== ; Main function ;================================================================================== (ssget '((0 . "text,mtext"))) (setq doc (vla-get-activedocument (vlax-get-acad-object)) objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs))) tol (car (vl-sort (mapcar 'vla-get-height objs) '<)) objs (PTE:sortobj objs "rdr" tol) ) (or (setq excel(vlax-get-or-create-object "Excel.Application")) (alert "Fail to Excel load") (exit) ) (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add) (vlax-put Excel 'visible :vlax-true) (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells) x 1 y 1 ) (foreach os objs (foreach o os (setq str (if (= (vla-get-objectname o) "AcDbText") (vla-get-textstring o) (LM:UnFormat (vla-get-textstring o) nil) ) ) (vlax-put-property cell 'item y x (strcat "'" str)) ;(setq x (1+ x)) ;edited line (setq y (1+ y) x 1) ;edited line ) ;(setq y (1+ y) x 1) ;edited line )(princ) ) (defun c:TEXTEXPORTINROW( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat) ; Sub-function - 01 (defun PTE:sortobj ( olst typ tol / typ objs opt npt lst data lst rev sx sy dxf x y PTE:s1 PTE:s2 PTE:s3 PTE:s4 ) (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls)) (defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b))))) (defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b))))) (defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o))))) (defun x (o) (car (dxf o 10))) (defun y (o) (cadr (dxf o 10))) (setq typ (vl-string->list (strcase typ))) (if (member (car typ) '(76 82)) (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev) (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev) ) (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs))) (foreach o objs (if (< tol (abs (- (setq npt (PTE:s2 o)) opt))) (setq lst (cons data lst) data (list o) opt npt) (setq data (cons o data)) ) ) (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst)) lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst) ) ) ; Sub-function - 02 (defun LM:UnFormat ( str mtx / _Replace regex ) ;; ⓒ Lee Mac 2010 (defun _Replace ( new old str ) (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new) ) (setq regex (vlax-get-or-create-object "VBScript.RegExp")) (mapcar (function (lambda ( x ) (vlax-put-property regex (car x) (cdr x))) ) (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) ) (mapcar (function (lambda ( x ) (setq str (_Replace (car x) (cdr x) str))) ) '( ("Ð" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) ) (setq str (if mtx (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_Replace "\\" "Ð" str) ) ) (vlax-release-object regex) str ) ;================================================================================== ; Main function ;================================================================================== (ssget '((0 . "text,mtext"))) (setq doc (vla-get-activedocument (vlax-get-acad-object)) objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs))) tol (car (vl-sort (mapcar 'vla-get-height objs) '<)) objs (PTE:sortobj objs "rdr" tol) ) (or (setq excel(vlax-get-or-create-object "Excel.Application")) (alert "Fail to Excel load") (exit) ) (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add) (vlax-put Excel 'visible :vlax-true) (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells) x 1 y 1 ) (foreach os objs (foreach o os (setq str (if (= (vla-get-objectname o) "AcDbText") (vla-get-textstring o) (LM:UnFormat (vla-get-textstring o) nil) ) ) (vlax-put-property cell 'item y x (strcat "'" str)) (setq x (1+ x)) ) ;(setq y (1+ y) x 1) ;edited line )(princ) ) maybe you want like this command TEXTEXPORTINCOLUMN I'm not original author of this code add 2 options by just edit last 3 lines. TEXTEXPORT : original lisp. justify rows and columns by it's location. TEXTEXPORTINCOLUMN : 1 column export TEXTEXPORTINROW : 1 row export