Leaderboard

@Emmanuel Delay Thank you Emmanuel!

No worries, try it and let me know. (defun c:Test (/ n c f i s e o) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (setq n "Layer" ;; Target layer name. ;; c 232 ;; Colour of Layer. ;; f 0.8 ;; Offset distance. ;; ) (and (or (tblsearch "LAYER" n) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 n) (cons 62 c) '(70 . 0) ) ) ) (setq i -1 s (ssget "_X" (list (cons 410 (getvar 'CTAB)) '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1) ) ) ) (while (setq i (1+ i) e (ssname s i) ) (and (setq g (entget e) o (entlast) ) (vlax-write-enabled-p (vlax-ename->vla-object e)) (vl-cmdf "_.OFFSET" f e "_none" (mapcar (function (lambda (j k) (* (+ j k) 0.5))) (vlax-curve-getstartpoint e) (vlax-curve-getpointatparam e 2) ) "" ) (not (= o (setq o (entlast)))) (entmod (subst (cons 8 n) (assoc 8 (setq e (entget o))) e)) ) ) ) (princ) ) (vl-load-com)

You posted on the weekend, be patient. Please use code tags, <> in the menu bar in the reply box. Your code looks incomplete, is that all of it?

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)

@aridzv Simply copy and paste the code directly on the command line (possibly validate behind the last parenthesis if it is displayed) and the code will be executed.

Cool, you are welcome anytime.

No, it won't work with ADDSELECTED + Cancel, but I've prepared something for you : (defun c:cc ( / LM:cecolorfromentity LM:true->rgb KGA_Sys_Transparency_Num_To_Perc KGA_Sys_Transparency_Perc_To_Num s e ex lay ) ;; CECOLOR from Entity - Lee Mac (defun LM:cecolorfromentity ( ent / enx tmp ) (setvar 'cecolor (cond ( (cdr (assoc 430 (setq enx (entget ent)))) ) ( (setq tmp (cdr (assoc 420 enx))) (apply 'strcat (mapcar '(lambda ( a b ) (strcat a (itoa b))) '("RGB:" "," ",") (LM:true->rgb tmp))) ) ( (null (setq tmp (cdr (assoc 62 enx)))) "BYLAYER" ) ( (zerop tmp) "BYBLOCK" ) ( (itoa tmp) ) ) ) ) ;; True -> RGB - Lee Mac ;; Args: c - [int] True Colour (defun LM:true->rgb ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)) ) ; (KGA_Sys_Transparency_Num_To_Perc 33554661) => 0.1 (= 10%) ; (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel)))))) (defun KGA_Sys_Transparency_Num_To_Perc ( num ) (* 0.01 (fix (/ (- 33554687 num) 2.55))) ) ; (KGA_Sys_Transparency_Perc_To_Num 0.1) => 33554661 (defun KGA_Sys_Transparency_Perc_To_Num ( perc ) (fix (- 33554687 (* perc 255))) ) (prompt "\nPick source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage...") (setq s (ssget "_+.:E:S")) (while (not s) (prompt "\nMissed... Try picking source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage again...") (setq s (ssget "_+.:E:S")) ) (if (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (setq ex (entget (setq e (ssname s 0)))))))))))) (setvar 'clayer lay) ) (if (assoc 6 ex) (setvar 'celtype (cdr (assoc 6 ex))) ) (if (assoc 48 ex) (setvar 'celtscale (cdr (assoc 48 ex))) ) (if (assoc 370 ex) (setvar 'celweight (cdr (assoc 370 ex))) ) (if (assoc 440 ex) (setvar 'cetransparency (* 100 (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 ex))))) (setvar 'cetransparency 0) ) (LM:cecolorfromentity e) (princ) ) HTH. M.R.

Run the command With the cursor wander over an entity already drawn. When the cursor passes over an entity its type appears on the status bar (instead of the display of coordinates) If it is this type of entity that you want to reproduce, validate with the right-click The appropriate drawing command will then be launched with the same properties. I can't explain anymore... Launch and watch the taskbar.