（如果不是，它会按照我上一篇文章的建议做）
命令：PERP
最后，查看命令栏：您将获得交点列表（具有次曲线的连接线）。
我只是不知道你对这些观点的意图是什么。
（星期一之前你不会收到我的来信）
;; @file: measure a curved line; every 500 units draw a perpendicular line.We are looking for the intersection of the perpendicular lines with a second curved line
;; @author: Emmanuel Delay - emmanueldelay@gmail.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; resources ...
(vl-load-com)
(setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main function
(defun perp (dist / curve-obj curve-second points xlines intersections)
(setq
curve-obj (entsel "\n Select a curve:") ;; client selects the curved object, to be measured
curve-second (entsel "\n Select a second curve:") ;; client selects the second object;
points (getMeasurePoints dist curve-obj) ;; list of all the points.From those points we draw the perpendicular lines
xlines (drawPerpendicularLines points curve-obj curve-second) ;; Construction lines (xline)
intersections (getIntersections xlines curve-second) ;; returns a list of intersection points
)
(princ "\nIntersection points:\n")
(princ intersections)
)
;; measures a polyline, returns a list of points, all "dist" away from each other, along the curve
(defun getMeasurePoints (dist curve / points needle pt)
(setq
needle dist
points (list)
pt nil
)
(while (and ;; repeat while vlax-curve-getPointAtDist keeps finding a new point
(setq pt (vlax-curve-getPointAtDist (car curve) needle))
(/= nil pt)
)
(setq
points (append points (list pt))
)
(setq needle (+ needle dist))
)
points
)
(defun drawPerpendicularLines (points curve curve-second / i pt p xlines vl-obj x)
(setq
i 0
xlines (list)
)
(repeat (length points)
(setq pt (nth i points))
(setq vl-obj (vlax-ename->vla-object (car curve)))
(setq x
(vlax-curve-getParamAtPoint vl-obj
(setq
p (vlax-curve-getClosestPointTo vl-obj pt)
)
)
)
(setq xlines (append
xlines
(list (drawPerpendicularLine curve curve-second x pt))
))
(setq i (+ i 1))
)
xlines
)
(defun drawPerpendicularLine (curve curve-second param pt / deriv PTDERIV ptg xline)
;; @see http://cadxp.com/topic/21475-vlax-curve-getfirstderiv/
(setq deriv (vlax-curve-getFirstDeriv (vlax-ename->vla-object (car curve)) param))
(setq PTDERIV (mapcar '+ pt deriv))
;; get a point, distance 10000.0, angle: perpendicular
(setq ptg (polar pt (+ (angle pt PTDERIV) (/ pi 2)) 10000.00))
(setq xline (drawXline ptg pt))
xline
)
(defun getIntersections (xlines curve-second / i intersects)
(setq
i 0
intersects (list)
)
(repeat (length xlines)
(setq intersects (append intersects (list
(vlax-invoke
(nth i xlines)
'IntersectWith
(vlax-ename->vla-object (car curve-second))
3)
)))
(setq i (+ i 1))
)
intersects
)
(defun drawXline (p1 p2)
(vla-AddXline modelSpace (vlax-3d-point p1) (vlax-3d-point p2))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; command PERP
(defun c:perp ( / )
(perp 500)
(princ)
)
(defun c:pso ( / cl1 cl2dpt pt2 templine ang spc )
;;; pBe 30Aug2014 ;;;
(if (and
(princ "\nSelect the main alignment")
(setq cl1 (ssget "_:S" '((0 . "*POLYLINE"))))
(princ "\nSelect the offset alignment")
(setq cl2 (ssget "_:S" '((0 . "*POLYLINE"))))
)
(progn
(setq d (cond ((getdist
(strcat "\nEnter increment value: " " <" (rtos (setq d
(cond ( d_ ) ( 100.00 ))
) 2 2) ">: ")))
( d )
)
)
(setq cl1 (ssname cl1 0)
cl2 (ssname cl2 0) d_ d)
(while (setq pt (vlax-curve-getpointatdist cl1 d))
(setq ang (angle '(0.0 0.0 0.0)
(vlax-curve-getfirstderiv
cl1
(vlax-curve-getparamatpoint cl1 pt)
)
)
)
(setq templine (vlax-invoke (setq spc (vlax-get
(vla-get-ActiveLayout
(vla-get-ActiveDocument (vlax-get-acad-object )))
'Block)) 'AddXline pt
(polar pt (setq ang (+ ang(* pi 1.5))) 1))
)
(if (setq pt2 (vlax-invoke
templine
'IntersectWith
(vlax-ename->vla-object cl2)
0
)
)
(vlax-invokespc 'Addline pt (list (Car pt2)(cadr pt2)(caddr pt2)))
)
(vla-delete templine)
(setq d (+ d d_))
)
)
)
(princ)
)
(vl-load-com)
命令：pso
页:
1
[2]