Jump to content

[LISP] Offset without indicating the point


Assgarth

Recommended Posts

Hi,

 

I need a function to offset any object for a distance X without indicating the point.

The function must self find the point.

 

For example:

(defun c:set_offset (entObj set_dist side) ... )

where:

entObj - (car(entsel))

set_dist - eg. 150.0

side - 0 or 1 where 0 - inside, 1 - outside

 

Now I draw to offset line for any object:

I have two points from LWPOLYLINE, and function "polar" +/- 90 degree, distance 0.1

For CIRCLE and ARC I have center point +/- radius, distance 0.1

etc.

 

and then check the length of the line.

If I want inside - the shortest

If I want outside - the longest

 

Do you have any idea how to write the function, and simple way how to find a two points for any object?

Or maybe other way... to offset the objects?

 

best regards,

Z

Link to comment
Share on other sites

Thank you Lee - it's working also in other CAD not for only AutoCAD - super ;)

 

(vla-offset (vlax-ename->vla-object (car(entsel)))) 150.0)

or

(vla-offset (vlax-ename->vla-object (car(entsel)))) -150.0)

 

can you tell me where can I find help for functions that are not in the AutoCAD help?

Link to comment
Share on other sites

Good stuff :)

 

As an aside, if you are looking to manipulate the resultant offset objects, it may be easier to use:

 

(vlax-invoke <VLA-Object> 'Offset <Offset Distance>)

Since this will return a list of VLA-Objects and you needn't convert the Safearray Variant of objects returned by vla-offset or vlax-invoke-method.

Link to comment
Share on other sites

My function:

 

(defun zk:Offset (entObj dist par_wz / vlaObj1 vlaObj2 dlg_1 dlg_2)

(cond ((equal (vla-Get-ObjectName (vlax-ename->vla-object entObj)) "AcDbPolyline")
(setq vlaObj1 (vlax-invoke (vlax-ename->vla-object entObj) 'Offset dist))
(setq dlg_1   (vla-Get-Length (vlax-ename->vla-object (entlast))))
(setq vlaObj2 (vlax-invoke (vlax-ename->vla-object entObj) 'Offset (* -1 dist)))
(setq dlg_2   (vla-Get-Length (vlax-ename->vla-object (entlast))))
     )
     ((equal (vla-Get-ObjectName (vlax-ename->vla-object entObj)) "AcDbCircle")
(setq vlaObj1 (vlax-invoke (vlax-ename->vla-object entObj) 'Offset dist))
(setq dlg_1   (vla-Get-Circumference (vlax-ename->vla-object (entlast))))
(setq vlaObj2 (vlax-invoke (vlax-ename->vla-object entObj) 'Offset (* -1 dist)))
(setq dlg_2   (vla-Get-Circumference (vlax-ename->vla-object (entlast))))
     )
);cond
				
(if (= par_wz 1)
(progn (if (< dlg_1 dlg_2) (vlax-erased-p (car vlaObj1)) (vlax-erased-p (car vlaObj2))))
(progn (if (> dlg_1 dlg_2) (vlax-erased-p (car vlaObj2)) (vlax-erased-p (car vlaObj1))))
);if

(princ (list vlaObj1 vlaObj2))
(princ)
)

;TEST:
(zk:Offset (car(entsel)) 50.0 1)

 

Tell me please, why not remove objects: vlaObj1 or vlaObj2?

Link to comment
Share on other sites

A very quick modification to your code to get it working for you:

 

(defun zk:Offset ( obj dist par_wz / vlaObj1 vlaObj2 dlg_1 dlg_2 )
 (if
   (cond
     ( (equal (vla-get-objectname obj) "AcDbPolyline")
       (setq vlaObj1 (car (vlax-invoke obj 'Offset dist))
             vlaObj2 (car (vlax-invoke obj 'Offset (- dist)))
             dlg_1   (vla-get-length vlaObj1)
             dlg_2   (vla-get-length vlaObj2)
       )
     )
     ( (equal (vla-get-objectname obj) "AcDbCircle")
       (setq vlaObj1 (car (vlax-invoke obj 'Offset dist))
             vlaObj2 (car (vlax-invoke obj 'Offset (- dist)))
             dlg_1   (vla-get-circumference vlaObj1)
             dlg_2   (vla-get-circumference vlaObj2)
       )
     )
   )
   (if (= par_wz 1)
     (if (< dlg_1 dlg_2)
       (vla-delete vlaObj1)
       (vla-delete vlaObj2)
     )
     (if (> dlg_1 dlg_2)
       (vla-delete vlaObj2)
       (vla-delete vlaObj1)
     )
   )
 )
 (princ)
)


(defun c:test ( / e )
 (if (setq e (car (entsel)))
   (zk:Offset (vlax-ename->vla-object e) 50.0 1)
 )
)

 

Note that vlax-erased-p tests whether an object is erased, and does not erase the object.

  • Thanks 1
Link to comment
Share on other sites

Thank you Lee ;)

 

Note that vlax-erased-p tests whether an object is erased, and does not erase the object.

also for the explanation ;)

Link to comment
Share on other sites

Hi,

 

my function looks like this:

 

;------------------------------------------------------------------------------------------------------------------------------------
;;----------------------------=={ zk:Offset }==------------------------------------;;
;;---------------------------------------------------------------------------------;;
;;  entObj  - (vlax-ename->vla-object entity_name)                                 ;;
;;  dist    - distance offset                                                      ;;
;;  par_wz  - paramter ins/out, value = 1 or 2                                     ;;
;;  insPt   - point or nil                                                         ;;
;;  TEST:   (zk:Offset (vlax-ename->vla-object (car(entsel))) 20.0 1 (getpoint))   ;;
;;---------------------------------------------------------------------------------;;
(defun zk:Offset (entObj dist par_wz insPt / oldSNAP vlaObj1 vlaObj2 dlg_1 dlg_2 objOffset)

(setq Err_NamePrc "zk:Offset")

(setq oldSNAP (getvar "OSMODE"))
(if entObj
	(progn
		(setvar "OSMODE" 0)
		(if (not insPt)
			(progn

				(cond ((equal (vla-Get-ObjectName entObj) "AcDbPolyline")		; or (vlax-get-property a 'ObjectName)
						(setq vlaObj1 (car(vlax-invoke entObj 'Offset dist))
						      vlaObj2 (car(vlax-invoke entObj 'Offset (- dist)))
						      dlg_1   (vla-Get-Length vlaObj1)
						      dlg_2   (vla-Get-Length vlaObj2))
					  )
					  ((equal (vla-Get-ObjectName entObj) "AcDbCircle")
						(setq vlaObj1 (car(vlax-invoke entObj 'Offset dist))
						      vlaObj2 (car(vlax-invoke entObj 'Offset (- dist)))
						      dlg_1   (vla-Get-Circumference vlaObj1)
						      dlg_2   (vla-Get-Circumference vlaObj2))
					  )
					  ((equal (vla-Get-ObjectName entObj) "AcDbArc")
						(setq vlaObj1 (car(vlax-invoke entObj 'Offset dist))
						      vlaObj2 (car(vlax-invoke entObj 'Offset (- dist)))
						      dlg_1   (vla-Get-ArcLength vlaObj1)
						      dlg_2   (vla-Get-ArcLength vlaObj2))
					  )
					  (T (princ "\nAre you crazy?!? This object comes from Mars - don't touch this!"))
				);cond
				
				(if (and vlaObj1 vlaObj2)
					(progn
						(if (= par_wz 1)
							(if (< dlg_1 dlg_2) (vla-delete vlaObj2) (vla-delete vlaObj1) )
							(if (> dlg_1 dlg_2) (vla-delete vlaObj2) (vla-delete vlaObj1) )
						);if
						(setq objOffset (entlast))
					);prrogn
				);if

			);progn
			(progn
				(command "_offset" dist (vlax-vla-object->ename entObj) insPt "")
				(setq objOffset (entlast))
			);progn
		);if
		(setvar "OSMODE" oldSNAP)(princ)
	);progn
);if
objOffset
);zk:Offset

 

RUN:

(zk:Offset (vlax-ename->vla-object (car(entsel))) 20.0 1 (getpoint))

or

(zk:Offset (vlax-ename->vla-object (car(entsel))) 20.0 1 nil)

 

and I have question about SPLINE - this object haven't "Length" property... :

 

Command: (vlax-dump-object vlaobj1)

; IAcadSpline: AutoCAD Spline Interface

; Property values:

; Application (RO) = #

; Area (RO) = 21551.3

; Closed (RO) = 0

; ControlPoints = (1305.96 1023.88 0.0 1307.02 1031.16 0.0 ... )

; Degree (RO) = 3

; Document (RO) = #

; EndTangent = AutoCAD.Application: General modeling failure

; FitPoints = nil

; FitTolerance = 0.0

; Handle (RO) = "2DC"

; HasExtensionDictionary (RO) = 0

; Hyperlinks (RO) = #

; IsPeriodic (RO) = 0

; IsPlanar (RO) = -1

; IsRational (RO) = 0

; Knots = (267.117 267.117 267.117 267.117 293.057 293.057 ... )

; Layer = "0"

; Linetype = "ByLayer"

; LinetypeScale = 1.0

; Lineweight = -1

; Material = "ByLayer"

; NumberOfControlPoints (RO) = 40

; NumberOfFitPoints (RO) = 0

; ObjectID (RO) = 2129103776

; ObjectName (RO) = "AcDbSpline"

; OwnerID (RO) = 2129095928

; PlotStyleName = "ByLayer"

; StartTangent = AutoCAD.Application: General modeling failure

; TrueColor = #

; Visible = -1

; Weights = AutoCAD.Application: No weights available for polynomial spline

T

 

but:

Command: _list

Select objects: 1 found

 

Select objects:

 

SPLINE Layer: "0"

Space: Model space

Handle = 2ac

Length: 2081.5120

Order: 4

Properties: Planar, Non-Rational, Non-Periodic

Parametric Range: Start 0.0000

End1864.9942

Number of control points: 7

Control Points: X = 1254.1609, Y = 883.1064 , Z = 0.0000

X = 978.9713 , Y = 826.5475 , Z = 0.0000

X = 1463.5260, Y = 2025.8431, Z = 0.0000

X = 2002.1848, Y = 1239.5131, Z = 0.0000

X = 2038.4173, Y = 1933.1067, Z = 0.0000

X = 2300.6016, Y = 1919.6280, Z = 0.0000

X = 2356.5996, Y = 1900.6565, Z = 0.0000

Number of fit points: 5

User Data: Fit Points

X = 1254.1609, Y = 883.1064 , Z = 0.0000

X = 1612.9939, Y = 1645.7289, Z = 0.0000

X = 1913.4625, Y = 1472.8966, Z = 0.0000

X = 2179.3448, Y = 1894.1753, Z = 0.0000

X = 2356.5996, Y = 1900.6565, Z = 0.0000

Fit point tolerance: 1.0000E-10

 

Start Tangent

X = -0.9795 , Y = -0.2013 , Z = 0.0000

 

End Tangent

X = 0.9471 , Y = -0.3209 , Z = 0.0000

 

it's only way to get this parametr is:

Command: (getvar "PERIMETER")

2081.51

 

exist alternative way??

Link to comment
Share on other sites

  • 8 years later...
On 04/07/2011 at 18:13, Lee Mac said:

A very quick modification to your code to get it working for you:

 

 


(defun zk:Offset ( obj dist par_wz / vlaObj1 vlaObj2 dlg_1 dlg_2 )
 (if
   (cond
     ( (equal (vla-get-objectname obj) "AcDbPolyline")
       (setq vlaObj1 (car (vlax-invoke obj 'Offset dist))
             vlaObj2 (car (vlax-invoke obj 'Offset (- dist)))
             dlg_1   (vla-get-length vlaObj1)
             dlg_2   (vla-get-length vlaObj2)
       )
     )
     ( (equal (vla-get-objectname obj) "AcDbCircle")
       (setq vlaObj1 (car (vlax-invoke obj 'Offset dist))
             vlaObj2 (car (vlax-invoke obj 'Offset (- dist)))
             dlg_1   (vla-get-circumference vlaObj1)
             dlg_2   (vla-get-circumference vlaObj2)
       )
     )
   )
   (if (= par_wz 1)
     (if (< dlg_1 dlg_2)
       (vla-delete vlaObj1)
       (vla-delete vlaObj2)
     )
     (if (> dlg_1 dlg_2)
       (vla-delete vlaObj2)
       (vla-delete vlaObj1)
     )
   )
 )
 (princ)
)


(defun c:test ( / e )
 (if (setq e (car (entsel)))
   (zk:Offset (vlax-ename->vla-object e) 50.0 1)
 )
)
 

 

 

Note that vlax-erased-p tests whether an object is erased, and does not erase the object.

 

 

@Lee Mac, What about AcDbxline ? i want to offset xline. Please help me!!

Link to comment
Share on other sites

How are you making the xline in the 1st place if 2 points then calculate a direction dummy point that is based on the offset value + or -. You imply the direction via the two pick points.

  • Thanks 1
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.

×
×
  • Create New...