Leaderboard

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 can switch off the CMDECHO system variable if the history of the command calls bothers you then reset it back to its original value, so here my initial attempt in this regard. (defun c:Test (/ 1pt 2pt 3pt hgt ang pt1) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (setq 1pt (getpoint "\nSpecify first extension line origin : ")) (setq 2pt (getpoint "\nSpecify second extension line origin : " 1pt)) (vl-cmdf "_.DIMLINEAR" "_non" 1pt "_non" 2pt "\\") (setq 3pt (getvar 'LASTPOINT) hgt (distance 2pt 3pt) ang (angle 2pt 3pt) pt1 1pt ) (progn (while (setq 1pt (getpoint "\nSpecify next extension line origin < enter = exit safely> : " 2pt)) (vl-cmdf "_.DIMLINEAR" "_non" 2pt "_non" 1pt "_non" 3pt) (setq 2pt 1pt) ) (vl-cmdf "_.DIMLINEAR" "_non" pt1 "_non" 2pt "_non" (polar 3pt ang hgt)) ) ) (princ) )

I moved your thread to the AutoLISP, Visual LISP & DCL Forum.

Excellent, you are welcome anytime.

Thanks, it worked fine

Although that I decided not to reply to any of your replies / comments due to your unwillingness in learning and being confident in copying & pasting codes from all around forums which means that you are wasting your free time here, and your question confirms what I am alluding to. If you knew what my codes do, then you would not have asked your question with that irrelevant narrative explanations.

Just been following this in the background a little BigAl - for direction, 'inside' and 'outside' I assume that inside is a shorter line than outside - no need to work out points and angles like CW / CCW so in this case I think this works and using this for the line length (setq Ent_Len (vla-get-length (vlax-Ename->Vla-Object EntName) )) For Tharwat, I'd be tempted to look at 'closed' polylines also being polylines where the first and last point coincide (with or without a 'fuzz factor') just in case they arn't true closed polylines, something like: (setq MySS (ssget "_X" (list '(0 . "LWPOLYLINE")))) (while loop..... (setq MyEnt (entget (ssname MySS n) )) (if (or (equal (assoc 10 MyEnt) (assoc 10 (reverse MyEnt)) (/ Offset 100) ) ;; fuzz factor, 1/100 offset distance (= 1 (cdr (assoc 70 MyEnt))) ) ; end or (progn..... Quickly putting that together, copy and pasted from other stuff, an no nice stuff added, something like this: (defun c:test ( / MyOffset MyLayer MySS EntName acount MyEnt obj Orig_Len New_Len ) (setq MyOffset 0.8) ; offset distance - user to define this ;; (setq Myoffset (getreal "Enter Offset Distance")) ; user to enter distance if required (setq MyLayer "0") ; Layer to copy to ;; (setq MyLayer (getstring "Enter Layer Name" T)) ; or user enters this ;;Do some checks here that the layer is valid (setq MySS (ssget "_X" (list '(0 . "LWPOLYLINE")))) ; Get Polylines ;; OR next line, not both ;; (setq MySS (ssget (list '(0 . "LWPOLYLINE")))) ; Get Polylines ;; User selects polylines (setq acount 0) ; just a counter (while (< acount (sslength MySS)) ;; loop through polylines in drawing (setq EntName (ssname MySS acount)) ;; get the entity to assess (setq MyEnt (entget EntName)) ;; entity descriptiob (if ;; if to offset 'closed' polylines or those that appear closed (or (equal (assoc 10 MyEnt) (assoc 10 (reverse MyEnt)) (/ MyOffset 100) ) ;; fuzz factor, 1/100 offset distance (= 1 (cdr (assoc 70 MyEnt))) ) ; end or (progn ; if closed polylines (setq obj (vlax-Ename->Vla-Object EntName)) ;; get entity object name (setq Orig_Len (vla-get-length obj)) ; get entity line length (vla-Offset (vlax-ename->vla-object EntName) MyOffset) ; offset the polyline (setq obj (vlax-Ename->Vla-Object (entlast))) ; get new offset entity name (setq New_Len (vla-get-length obj)) ; get new offset entity length (if (< Orig_Len New_Len) ; if offset line is longer than original, reverse offset (progn (entdel (entlast)) (vla-Offset (vlax-ename->vla-object EntName) (* -1 MyOffset)) ;; negative offset ) ) (vla-put-layer (vlax-EName->vla-Object (entlast)) MyLayer) ;; change layer ) ; end progn ) ; end if (setq acount (+ acount 1)) ) ; end while (princ) ); end defun

Somewhere had create a object based on pick which is what you want, try this can add more properties. ; matches pick object for next command plus layer ; created 2011 ; sorry no author (defun c:ZZZ (/ ent Obj lEnt) (vl-load-com) (while (setq ent (car (nentsel "\nSelect Object: "))) (setq Obj (vlax-ename->vla-object ent) typ (cdr (assoc 0 (entget ent)))) (cond ((vl-position typ '("CIRCLE" "ARC" "ELLIPSE" "SPLINE" "XLINE")) (comInv typ nil) (PropMatch Obj (entlast))) ((eq "LWPOLYLINE" typ) (comInv "pline" nil) (PropMatch Obj (entlast))) ((eq "LINE" typ) (setq lEnt (entlast)) (comInv typ nil) (foreach ent (EntCol (if lEnt lEnt (entlast))) (PropMatch Obj ent))) ((eq "HATCH" typ) (setq lEnt (entlast)) (comInv typ t) (if (not (eq lEnt (entlast))) (PropMatch Obj (entlast)))) ((eq "VIEWPORT" typ) (setq lEnt (entlast)) (comInv "-vports" nil) (if (not (eq lEnt (entlast))) (PropMatch Obj (entlast)))))) (princ)) (defun PropMatch (bObj dObj) (or (eq 'VLA-OBJECT (type bObj)) (setq bObj (vlax-ename->vla-object bObj))) (or (eq 'VLA-OBJECT (type dObj)) (setq dObj (vlax-ename->vla-object dObj))) (foreach prop '(Layer Linetype LinetypeScale Color Lineweight ViewportOn ShadePlot DisplayLocked GradientAngle GradientCentered GradientColor1 GradientColor2 GradientName HatchObjectType HatchStyle ISOPenWidth Origin PatternAngle PatternDouble PatternScale PatternSpace) (if (and (vlax-property-available-p bObj prop) (vlax-property-available-p dObj prop T)) (vlax-put-property dObj prop (vlax-get-property bObj prop))))) (defun EntCol (x / x) (if (setq x (entnext x)) (cons x (EntCol x)))) (defun comInv (com flag) (if flag (initdia)) (command (strcat "_." com)) (while (eq 1 (logand 1 (getvar "CMDACTIVE"))) (command pause)))

Had a play with startapp, shell, and powershell using findstr, pretty sure could get one of them to work passing the command to the windows operating system, so very fast. This worked bat file that you would write with lisp so look for string aaa c:\\windows\\syswow64\\findstr.exe aaa D:\\lisp\\*.lsp pause Lisp code to call the bat file (startapp "D:\\acadtemp\\test.bat")

Ok understand makes lots of sense think about motor racing where this is done for street circuits.

Referring you to BigAls comment above, how is the LISP to determine which side of a line is 'inside' and which is 'outside' (for example draw a line left to right and another right to left, 'inside will be on opposite sides because the lines were drawn in opposite directions). There might be some additional coding needed to work out or correct a line direction depends on the rules you want to follow. Ultimately to replace (vl-cmdf "_.OFFSET" *off* (ssname s 0) "_none" p "") with (vla-offset ..... If you look at Lee Macs website, ssget functions that will give you the details to change Tharwats code to select all from select a single entity, looking to replace ... (ssget "_+.:S:E:L" ... with ... (ssget "_X" ... where 'X' refers to everything, or leave it out for user selection. ... (ssget ...

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)

@Huuthanh As I understand, the task to do is to draw a partial POLYGON, 20 units sides and 120 units length , following the original Polyline1 path.

On the right side you have a kink without an arc. Is that correct ? If you look at the formula for an arc & chord you can work out the tangent points, given a R radius. You have a 10-10 IP calc. Pythagoras and a/sin a=b/sin b=c/sin c so can work out angle by rearranging the sine formula, as one angle is 90 degrees, but hypotenuse has to be calculated.

Look into CW and CCW direction of plines, then an offset to inside is controlled by this direction, using say, vla-offset obj 1, will go in or out depending on pline direction, simple for closed plines.