按层划分的线交点
大家好，我的情况是，我有许多样条线在不同的层中。我将这些线与“0”层中的许多线相交。
我想能够提取x，y，z格式的交点。
我当前的步骤是选择我想要的曲线层，使用下面的lisp，对所有线重复，使用数据提取按层排序的x、y、z。
当前，INTLINES查找任何直线的交点并在其中放置一个点。
我需要lisp在被相交的直线层中创建点？有人能帮我吗？
(vl-load-com)
;;-----------------------------------------------
;; CDNC5-02.LSP
;; Bill Kramer
;; (modifications and enhancements by CAD Studio, www.cadstudio.cz , 2010-2014)
;;
;; ILSIMPLEMODE = Tfor single intersection only(large coord problem)
;;
;; Find all intersections between objects in
;; the selection set SS.
;;
;; ---------------------------------------------- BEGIN LISTING 1
;;
(defun get_all_inters_in_SS (SS /
SSL ;length of SS
PTS ;returning list
aObj1 ;Object 1
aObj2 ;Object 2
N1;Loop counter
N2;Loop counter
iPts ;intersects
C1 C2 C3
)
(defun iL->L (iPts / Pts) ; convert coordlist -> pointlist
(while (> (length iPts) 0)
(setq Pts (cons (list (car iPts)
(cadr iPts)
(caddr iPts))
Pts)
iPts (cdddr iPts)))
Pts
)
(defun iL2->L (iPts / Pts) ; convert coordlist -> pointlist 2D
(while (> (length iPts) 0)
(setq Pts (cons (list (car iPts)
(cadr iPts)
'0.0)
Pts)
iPts (cddr iPts)))
Pts
)
(defun DelDup ( l / x r ) ; remove duplicates
(while l
(setq x (car l)
l (vl-remove x (cdr l))
r (cons x r)
)
)
(reverse r)
)
(setq N1 0 ;index for outer loop
SSL (sslength SS))
; Outer loop, first through second to last
(while (< N1 (1- SSL)) ;nebo <= ?
; Get object 1, convert to VLA object type
(setq aObj1 (ssname SS N1)
aObj1 (vlax-ename->vla-object aObj1)
N2 (1+ N1)) ;index for inner loop
; self-intersections:
(if (vlax-property-available-p aObj1 'Coordinates)(progn ; is it a curve? LWPOLY
(setq C1 (iL2->L (vlax-get aObj1 'Coordinates)))
(setq C2 (iL->L (vlax-invoke aObj1 'IntersectWith aObj1 0)))
(setq C3 (vl-remove-if '(lambda ( x ) (member x C1)) C2))
; (PRINT C1)(PRINT C2)(PRINT C3)
(if C3 (foreach x C3 (setq Pts (cons x Pts)))) ; add selfs
))
(if (= (vlax-get aObj1 'ObjectName) "AcDbSpline")(progn ; SPLINE
(setq C1 (iL->L (vlax-invoke aObj1 'IntersectWith aObj1 0)))
; (PRINT C1)
(if C1 (foreach x C1 (setq Pts (cons x Pts)))) ; add selfs
))
; Inner loop, go through remaining objects
(while (< N2 SSL) ; innser loop
; Get object 2, convert to VLA object
(setq aObj2 (ssname SS N2)
aObj2 (vlax-ename->vla-object aObj2)
; Find intersections of Objects
iPts (vla-intersectwith aObj1
aObj2 0)
; variant result
iPts (vlax-variant-value iPts))
; Variant array has values?
(if (> (vlax-safearray-get-u-bound iPts 1)
0)
(progn ;array holds values, convert it
(setq iPts ;to a list.
(vlax-safearray->list iPts))
;Loop through list constructing points
; (setq Pts (iL->L iPts)) ; must be global
;(if (> (length iPts) 3)(PRINT iPts)) --- LIST DUPLICATE INTERSECTIONS - THE RED/GREEN CASE GIVES TWO INTERSECTIONS !
(while (> (length iPts) 0)
(setq Pts (cons (list (car iPts)
(cadr iPts)
(caddr iPts))
Pts)
iPts (cdddr iPts))
(if ILSIMPLEMODE (setq iPts nil)); ILSIMPLEMODE - take only the first intersection
)
))
(setq N2 (1+ N2))) ;inner loop end
(setq N1 (1+ N1))) ;outer loop end
Pts) ;return list of points found
;;----------------------------------------------- END LISTING 1
;;
;; Remaining lines of code for download version, used to demonstrate and test the utility in Listing 1.
;;
;; Process - Create drawing with intersecting lines and lwpolylines.
;; Load function set
;; Run command function INTLINES
;; Intersections are marked with POINT objects on current layer
;;
(defun C:INTLINES ( / SS1 PT ptl oldos)
(prompt "\nINTLINES running to demonstrate GET_ALL_INTERS_IN_SS function.")
(setq SS1 (ssget);(ssget "_X");(get_all_lines_as_SS)
PTS (get_all_inters_in_ss SS1)
)
(setq ptl (length PTS) PTS (deldup PTS)) ; duplicates - shouldn't be any
(if (> ptl (length PTS)) (princ (strcat "\n" (itoa (- (length PTS) ptl)) " duplicates removed")))
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setvar "CMDECHO" 0)
(setq oldos (getvar "OSMODE"))(setvar "OSMODE" 0)
(foreach PT PTS ;;Loop through list of points
(command "_POINT" PT)) ;;Create point object (you can also use INSERT, CIRCLE, etc. here)
(setvar "PDMODE" 34) ;;display points so you can see them
(command "_REGEN")
(setvar "OSMODE" oldos)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ (strcat (itoa (length PTS)) " intersections found."))
(princ)
)
;;
;;-----------------------------------------------
;;Get all lines and lwpolyline objects in the
;;drawing and return as a selection set.
;;
(defun get_all_Lines_as_SS ()
(ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
;;
(princ "\n(get_all_inters_in_SS) function and INTLINES command loaded.")
(prin1)
或者，如果有人知道以特定间隔提取曲线x，y坐标的任何替代方法，我将非常感谢您的来信。
谨致问候，
ssredman公司 它们是否已经存在直线和样条曲线？ 样条线和垂直线已经存在。
我已经放置了垂直线，以便可以拉出足够数量的数据点。如果有一种提取点的替代方法，那么这些线将是不必要的，也不需要开始。
谢谢
点实体是否放置在给定距离上？或段数？
无论如何。。。在给定距离下尝试此提示。
(defun c:pntat (/ dist splines i e layer pts sp ep d)
(if (and (setq dist (getdist "\nEnter Segment Distance: ")
ds dist
)
(setq splines (ssget '((0 . "SPLINE"))))
)
(repeat (setq i (sslength splines))
(setq e (ssname splines (setq i (1- i))))
(setq layer (cdr (assoc 8 (entget e))))
(setq pts (list (vlax-curve-getStartPoint e)
(vlax-curve-getEndPoint e)
)
)
(setq pts (if (< (Caar pts) (caadr pts))
pts
(reverse pts)
)
)
(setq sp (list (min (Caar pts) (caadr pts))
(setq y (min (cadar pts) (cadadr pts)))
0.0
)
ep (list (max (Caar pts) (caadr pts))
y
0.0
)
d(distance sp ep)
)
(while (< dist d)
(entmakex
(list (cons 0 "POINT")
(cons 8 layer)
(cons 10
(vlax-curve-getClosestPointToProjection
e
(polar sp 0.0 dist)
'(0 1 0)
)
)
)
)
(setq dist (+ dist ds))
)
(setq dist ds)
)
)
(princ)
)
无论样条曲线的起点在哪里。距离始终是从左到右
HTH公司 埃德曼先生，
你真的需要你的点在恒定的x距离吗？
如果不是，请查看“vlax curve getPointAtDist”
这将为您提供曲线上31个点的列表：
（defun c:test（）（if（setq en（car（entsel“\n选择多段线：）））（progn（setq dtot（vlax curve getDistAtPoint en（vlax curve getEndPoint en））dist（/dtot 30）pointlist nil cum 0）（而（ 谢谢你，pBe，效果很好。
也感谢ymg3。 所以，为了找到两条直线或曲线之间的交点，我必须学习Lisp？AutoCAD中没有执行此任务的命令？
谢谢你的回答。 赫奇科，
对象捕捉到交点或明显交点即可
从命令行。不过，一次只能一点。
ymg公司 谢谢ymg3，首先我必须在工具栏中找到明显的交点。 它不在工具栏中，而是一个Osnap。
在命令中单击鼠标右键时，弹出菜单
将显示您选择的外观。
ymg公司
页:
[1]
2