遵循路径
有人请把我从痛苦中解救出来！我已经为此奋斗了两天。我正在编写一个程序来执行以下操作：
1.）选择块
2.）选取（2）个位置点
3.）选择路径
4）给出步距
在给出这些信息后，我希望程序以步进距离沿着给定路径步进块。
我把一切都搞定了，只有一个例外。如何计算直线和圆弧之间的过渡？我的大脑只是把公式写在代码里。我知道这是可能的。
我附上了一张图片来帮助澄清。位置3就是问题所在。
提前感谢您，
布瑞恩
看起来Measure命令可以完成您想要完成的任务。
我同意，但我想让程序逐步完成动作。我有一个可以这样做的程序，但我丢了，找不到该程序的副本。我在第12版中就这么做了。
非常感谢。
布瑞恩
什么是定位点？那些标有红色和蓝色的？如果是这样，“measure”命令将不能完全满足您的需要。 看看vlax曲线函数，它会给你你需要的
顺便说一句，vlax曲线-*不仅仅适用于圆弧
在一般情况下，这是非常困难的。但如果你把它限制在一些特定的条件下（曲线的形状和尺寸），我认为我们可以解决它。
你能用完整的元素（曲线和块）发布你的绘图文件吗？ 红色和蓝色点必须始终与路径保持接触。它们代表输送机上的手推车，相距固定。（200.0mm）
我将检查vlax曲线函数。我以前没有用过。
我附上了一个例子的副本。我希望这有帮助。今天晚些时候，在我清理了一下程序后，我会发布一份程序的副本。
非常感谢。
布瑞恩
路径图纸 我认为，试图通过一个过渡来计算这一点将是一场噩梦。iff线与弧或路径不相切的是样条曲线，或。。。。
所以我建议使用一种类似于手动操作的方法。这将是在小车的前部绘制一个圆，R=200，它与轨道相交的地方是小车的后部。该例程将放置一个圆，用函数“vla intersectwith”确定轨道的2个交点。这将为您提供一个或两个交点。如果有2个点，则找到沿曲线最开始处的一个点（vlax曲线函数之一）。 试试“Path.dwg”
将块插入点作为“位置点1”
它相当慢，有点不准确（取决于模糊变量），没有错误捕捉
(vl-load-com)
(defun test (/
Dist
EndDist
EndPoint
Fuzz
LineLength
BlockObj
PathObj
StartPoint
Step
Point1
Point2
MSpaceObj
)
(setq MSpaceObj (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(princ "\nSelect BLOCK: ")
(setq BlockObj (vlax-ename->vla-object (car (entsel)))
Point1 (vlax-safearray->list
(vlax-variant-value (vla-get-InsertionPoint BlockObj))
)
Point2 (getpoint Point1 "\nPick location point 2: ")
LineLength (distance Point1 Point2)
)
(princ "\nSelect PATH: ")
(setq PathObj (vlax-ename->vla-object (car (entsel))))
(setq EndDist (vlax-curve-getDistAtParam PathObj (vlax-curve-getEndParam PathObj)))
(setq Step (getreal "\nEnter stepping distance: ")
Fuzz 0.01
Dist 0.0
)
(while (< Dist EndDist)
(setq StartPoint (vlax-curve-getPointAtDist PathObj Dist))
(while (and (< (setq Dist (+ Dist Fuzz)) EndDist)
(< (distance StartPoint
(setq EndPoint (vlax-curve-getPointAtDist PathObj Dist))
)
LineLength
)
)
)
(if (< Dist EndDist)
(progn (vla-InsertBlock
MSpaceObj
(vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 2)) StartPoint))
(vla-Get-Name BlockObj)
1.0
1.0
1.0
(angle StartPoint EndPoint)
)
(setq Dist (+ Dist Step))
)
)
)
(vlax-release-object PathObj)
(vlax-release-object BlockObj)
(vlax-release-object MSpaceObj)
(princ)
)
我同意卡尔的观点。这不是专家方法，但给出了准确的结果。
这是代码：
;;;===========================================
;;;Move objects along curve path
;;;Written by ssg - October 25th, 2007
;;;===========================================
;;;-------------------------------------------------------------------------------
(defun rtd(x) (/ (* x 180) pi) ) ;;;Change radian to degree
;;;-------------------------------------------------------------------------------
(defun Collect(e / ent2 SS1 SS2) ;;;Selection set from e to entlast
(setq SS1 (ssadd))
(ssadd e SS1)
(while (setq ent2 (entnext e))
(ssadd ent2 SS1)
(setq e ent2)
)
(setq SS2 SS1)
)
;;;-------------------------------------------------------------------------------
(defun Collect1(e / ss)
;;;Selection set after e to entlast. If e nil, select from fist entity of drawing.
(if (= e nil) (setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------
(defun ints (e1 e2 / ob1 ob2 V L1 L2)
;;;Get intersections of e1, e2. Return LIST of points
(setq
ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
)
(setq V (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound V 1) -1)
(progn
(setq L1 (vlax-safearray->list V) L2 nil)
(while L1
(setq L2 (append L2 (list (list (car L1) (cadr L1) (caddr L1)))))
(repeat 3 (setq L1 (cdr L1)))
)
)
(setq L2 nil)
)
L2
)
;;;------------------------------------------------------------------------------
(defun getnearP (p p1 p2) ;;;Get nearer point by p. Return p1 or p2
(if (<= (distance p p1) (distance p p2)) p1 p2)
)
;;;------------------------------------------------------------------------------
(defun getpL(e st / el ss i et p pL)
;;;Get list of points by measure command, specified by curve e and step st
(setq el (entlast))
(command "measure" e st )
(setq ss (collect1 el) i 0)
(repeat (sslength ss)
(setq
et (ssname ss i)
p (cdr (assoc 10 (entget et)))
pL (append pL (list p))
i (1+ i)
)
)
(command "erase" ss "")
pL
)
;;;------------------------------------------------------------------------------
(defun MoveStep()
(repeat (length pL)
(setq p3 (nth j pL))
(setq pa3 (vlax-curve-getParamAtPoint cur p3))
(if (>= (* flag pa3) (* flag pa1))
(progn
(command "circle" p3 r)
(setq ipL (ints cur (entlast)))
(if (> (length ipL) 1)
(setq p4 (getnearP p1 (car ipL) (cadr ipL)))
(setq p4 (car ipL))
)
(command "erase" (entlast) "")
(command "move" ob "" p1 p3)
(command "rotate" ob "" p3 (rtd (- (angle p3 p4) ag)))
(setq p1 p3 ag (angle p3 p4))
(command "delay" 100)
)
)
(setq j (1+ j))
)
)
;;;===================MAIN====================
(defun C:MST( / ob p1 p2 cur pa1 pa2 st pL r ag j flag oldos p3 pa3 ipL p4)
(vl-load-com)
(prompt "Select objects will be moved...")
(setq
ob (ssget)
p1 (getpoint "\nFirst point (front):")
p2 (getpoint "\nSecond point (back):")
cur (car (entsel "\nSelect path:"))
pa1 (vlax-curve-getParamAtPoint cur p1)
pa2 (vlax-curve-getParamAtPoint cur p2)
)
(if (not (and pa1 pa2)) (progn (alert "1 or 2 points not on the path!") (exit)))
(setq
st (getreal "\nStep:")
pL (getpL cur st)
r (distance p1 p2)
ag (angle p1 p2)
j 0
)
(if (> pa2 pa1) (progn (setq pL (reverse pL)) (setq flag -1)) (setq flag 1))
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(MoveStep)
(setvar "osmode" oldos)
(princ)
)
;;;===========================================
;;;NOTE
;;;Path is any types: line, pline, polygon, spline, circle, arc
;;;Objects: allow to select many objects that are any types (not block only) and lying anywhere
;;;But "First point" and "Second point" must be on the path
;;;I have tested with many cases, didn't find errors
;;;Positions of objects on the path are exact diametrically!
;;;But I think maybe it don't run correctly with some extraordinary curves
页:
[1]
2