It is more like the intersection of the poly’s or splines with a plane i.e., where a curve crosses Z = 15000.
I have to say it is not an easy task in VBA (without the Curve Functions).I could have tried it in C#, but I have no way of testing .NET code against 2006.
Here (and in my original post) I used a Mirror3D and then IntersectWith to get the appropriate intersections.
To use load and run PointsAtElevation
To run a VBA routine:
http://www.cadtutor.net/forum/showthread.php?t=30608
*Edit - Works with AutoCAD 2009 but not 2004.
Option ExplicitSub PointsAtElevation()Dim dblPt(2) As DoubleDim ent As AcadEntityDim entMirror As AcadEntityDim varMin As VariantDim varMax As VariantDim dblThird(2) As DoubleDim dblElevation As DoubleDim varElevPt As VariantDim varReturn As VariantDim intCount As IntegerDim i As IntegerDim entPt As AcadPointDim objSS As AcadSelectionSetDim strKeyWordList As StringDim intAxis As IntegerDim strTemp As StringDim dblElev As DoubleDim varFilter As VariantDim strKeyWord As StringDim blnErase As BooleanWith ThisDrawingstrKeyWordList = "X x Y y Z z".Utility.InitializeUserInput 1, strKeyWordListOn Error Resume NextstrKeyWord = .Utility.GetKeyword("Enter axis of interest : ")If Err Then Exit SubIf UCase(strKeyWord) = "X" Then intAxis = 0ElseIf UCase(strKeyWord) = "Y" Then intAxis = 1ElseIf UCase(strKeyWord) = "Z" Then intAxis = 2Else .Utility.Prompt (vbCr & "Invalid input!") Exit SubEnd If strKeyWordList = "*".Utility.InitializeUserInput 128, strKeyWordListvarElevPt = .Utility.GetPoint(, "Select target elevation, or input elevation value: ")strTemp = .Utility.GetInput() If UBound(varElevPt)2 Then Err.Clear dblElev = CDbl(strTemp) If Err Then Exit SubElse dblElev = varElevPt(intAxis)End IfOn Error GoTo 0varFilter = LoadFilterArray(intAxis)If SoSSS(varFilter(0), varFilter(1)) > 0 Then For Each ent In .SelectionSets("TempSSet") If TypeOf ent Is AcadLWPolyline Then Set ent = ProcessPoly(ent) blnErase = True End If ent.GetBoundingBox varMin, varMax varMin(intAxis) = dblElev varMax(intAxis) = dblElev dblThird(0) = varMin(0) + 1# dblThird(1) = varMin(1) + 1# dblThird(2) = varMin(2) + 1# Set entMirror = ent.Mirror3D(varMin, varMax, dblThird) varReturn = entMirror.IntersectWith(ent, acExtendNone) intCount = ((UBound(varReturn) + 1) / 3) - 1 For i = 0 To intCount dblPt(0) = varReturn(3 * i) dblPt(1) = varReturn(3 * i + 1) dblPt(2) = varReturn(3 * i + 2) ThisDrawing.ModelSpace.AddPoint (dblPt) Next If blnErase Then ent.Delete: blnErase = False entMirror.Delete NextEnd IfEnd WithEnd SubPrivate Sub SSClear()Dim SSS As AcadSelectionSetsSet SSS = ThisDrawing.SelectionSetsIf SSS.Count > 0 Then Dim objSS As AcadSelectionSet For Each objSS In SSS If objSS.Name = "TempSSet" Then objSS.Delete: Exit Sub NextElse Exit SubEnd IfEnd SubFunction SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As IntegerDim TempObjSS As AcadSelectionSetSSClearSet TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet") 'pick selection setIf IsMissing(grpCode) Then TempObjSS.SelectOnScreenElse TempObjSS.SelectOnScreen grpCode, dataValEnd IfSoSSS = TempObjSS.CountEnd FunctionFunction LoadFilterArray(intAxis As Integer) As VariantDim intCode(21) As IntegerDim varData(21) As VariantDim varArray(1) As VariantDim dblAxis1(2) As DoubleDim dblAxis2(2) As DoubleDim dblAxis3(2) As DoubleDim dblAxis4(2) As Double dblAxis1((intAxis + 1) Mod 3) = 1#dblAxis2((intAxis + 2) Mod 3) = 1#dblAxis3((intAxis + 1) Mod 3) = -1#dblAxis4((intAxis + 2) Mod 3) = -1#intCode(0) = -4: varData(0) = "" varArray(0) = intCodevarArray(1) = varDataLoadFilterArray = varArrayEnd FunctionFunction ProcessPoly(ent As AcadLWPolyline) As Acad3DPolylineDim dblNormal() As DoubleDim varPLCoord As VariantDim dblCoords() As DoubleDim intUbound As IntegerDim i As IntegerDim varDummy As VariantDim dblElev As DoubleDim dblTransfer(2) As DoubledblNormal = ent.NormaldblElev = ent.ElevationintUbound = ((UBound(ent.Coordinates) + 1) / 2) - 1ReDim dblCoords((((intUbound + 1) * 3) - 1))For i = 0 To intUboundvarPLCoord = ent.Coordinate(i)dblTransfer(0) = varPLCoord(0)dblTransfer(1) = varPLCoord(1)dblTransfer(2) = dblElevvarPLCoord = ThisDrawing.Utility.TranslateCoordinates(dblTransfer, acOCS, acWorld, 0, dblNormal)dblCoords(i * 3) = varPLCoord(0)dblCoords(i * 3 + 1) = varPLCoord(1)dblCoords(i * 3 + 2) = varPLCoord(2)NextSet ProcessPoly = ThisDrawing.ModelSpace.Add3DPoly(dblCoords)End Function Here's a 2004 compatible version.
Apparently VBA support for Normals of Planar Splines was not available back in 2004.This routine (AC2004Compatible.txt) employs a different approach.
One additional note, both this and the routine posted previously handle only LightWeightPolys and/or Planar Splines.
Edit:See updated code http://www.cadtutor.net/forum/showpost.php?p=222822&postcount=22 Ahh, maybe the code I posted was not the best suited then
I had a look at using the curve functions in VL, but couldn't think how to get a point on the curve at some user defined elevation without using some iterative process by which one would move along the curve at small intervals until you get close enough by some tolerance to the required elevation
I didn't like this method and so didn't pursue it. You mention that you used "mirror3d" followed by "intersectWith", just curious (and I am not too conversant with VBA), how did the "mirror3d" come into it
Thanks
Lee The OP stated that all the Curves in question would be planar and aligned to one of the three main orthographic planes.Because of that a Bounding Box call will return essentially a planar expanse and, if the target elevation is substituted for the appropriate coordinate of min and max, it would create a nice line across the curve.
My original notion was to use that line to IntersectWith the curve.For some reason (which I have yet to figure out) that was not giving me any intersections.For the hell of it, I tried to use identical entities, and figured one was readily available if I 3Dmirrored the original curve about that elevation line and calc’ed point (see Sample).
Those intersect well enough.
MirrorIntersect.dwg Ahh, I see - so how I understand it is that "intersectwith" seems to only work in the x-y plane.
Thats funny, because, if you try my posted LISP to find the intersections between the splines and the polylines in the OP's posted drawing, it returns nil until you try it on a spline and pline in the x-y plane.
Lee
PS>Great example drawing - well drafted. IntersectWith does seem a bit spotty.The same mirror method does not work with Lightweight polylines. *
I guess with polylines, in particular, their planar quality is virtually a core component of their entity type.It sort of makes sense that their implementation of IntersectWith is extremely sensitive to common planes. Have you tried IntersectWith between a poly and spline on a common plane other than WCS’s XY?It may work if they were both on the XZ, for instance.
Splines are not required to be planar, thus may have gotten a little more attention from the boys at Autodesk with regard to intersections between planes.
* I had to provide a conversion to splines to get my routine to work with LWPolys.In fact, if the polys are too coarse, there may be significant error to the calculated elevation points. Ahh good thinking Sean, they may have only accommodated intersecting Plines within the same plane.
Tbh, I haven't spent much time on the IntersectWith method ~ I wrote a couple of LISPs a while back though, just messing around with it, could be worth some experimentation with them to see where we stand
(defun ssInter (ss / i y Ent1 Ent2 iArr iLst) (setq i (sslength ss)) (while (not (minusp (setq y (1- i) i (1- i)))) (setq Ent1 (vlax-ename->vla-object (ssname ss i))) (while (not (minusp (setq y (1- y)))) (setq Ent2 (vlax-ename->vla-object (ssname ss y)) iArr (vlax-variant-value (vla-IntersectWith Ent1 Ent2 acExtendNone))) (if (> (vlax-safearray-get-u-bound iArr 1) 0) (progn (setq iLst (vlax-safearray->list iArr)) (while (not (zerop (length iLst))) (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst) iLst (cdddr iLst))))))))(defun c:test (/ ptLst) (vl-load-com) (ssInter (ssget)) (alert (vl-princ-to-string ptLst)) (princ))
(defun ssInter (ss / vLst i j obj1 obj2 iArr iLst) (setq vLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) i (length vLst)) (while (not (minusp (setq j (1- i) i (1- i)))) (setq obj1 (nth i vLst)) (while (not (minusp (setq j (1- j)))) (setq obj2 (nth j vLst) iArr (vlax-variant-value (vla-IntersectWith obj1 obj2 acExtendNone))) (if (> (vlax-safearray-get-u-bound iArr 1) 0) (progn (setq iLst (vlax-safearray->list iArr)) (while (not (zerop (length iLst))) (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst) iLst (cdddr iLst))))))))(defun c:test (/ ptLst) (vl-load-com) (ssInter (ssget)) (alert (vl-princ-to-string ptLst)) (princ))
They both do pretty much the same thing - find all intersections in a selection set. But the second approach the selection set as a list of entities, whereas the first just hits the set head on.
I was just experimenting with different ways to accomplish the same goal - could be useful though, for testing with IntersectWith.
Cheers
Lee Nice.Those will help determine where and when intersections can be acquired.
Now that we’ve talked about it, I wonder if 3DPoly’s are more or less capable of finding Intersections. Next time I’m in front of AutoCAD, I’ll use your routine to test them.That alternative may help me reduce the Spline induced error I mentioned previously.
I feel honoured
页:
1
[2]