求各线交点数，急急！

wyu

图层1有首尾相连的线段组成的线条若干条，图层2有一些线段、园弧、样条曲线，如何统计一区域内（两点确定的矩形范围内）图层2各线和图层1各线的交点的数量，并修改指定位置的统计文字。用lisp编写。谢谢了！！！！！！！

龙龙仔

wyu

这是电信部门绘制电缆线路图用，在电缆上的一处保护，就用一和电缆相交的各种形状的线条表示，就各交点，就能求出电缆保护的数量，盼各高手帮忙。

龙龙仔

;;;这是一个求交点的程序
;;;如何统计一区域内（两点确定的矩形范围）
;;;图层2各线和图层1各线的交点的数量
;;;并修改指定位置的统计文字。
;;-----------------------------------------------
;; CDNC5-02.LSP
;; Bill Kramer
;; Find all intersections between objects in
;; the selection set SS.
;; 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 (/ SSL                ;length of SS
                   PTS                        ;returning list
                   AOBJ1                ;Object 1
                   AOBJ2                ;Object 2
                   N1                        ;Loop counter
                   N2                        ;Loop counter
                   IPTS                        ;intersects
                   A HOLDOSMODE)
  (vl-load-com)
  (command "_.UNDO" "_GROUP")
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq SS (ssget '((0 . "*LINE,ARC"))))
  (setq        N1  0                                ;index for outer loop
        SSL (sslength SS)
  )                                        ; Outer loop, first through second to last
  (while (< N1 (1- SSL))                ; 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
;;; Inner loop, go through remaining objects
    (while (< N2 SSL)                        ; 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
          (while (> (length IPTS) 0)
            (setq PTS  (cons (list (car IPTS)
                                   (cadr IPTS)
                                   (caddr IPTS)
                             )
                             PTS
                       )
                  IPTS (cdddr IPTS)
            )
          )
        )
      )
      (setq N2 (1+ N2))
    )                                        ;inner loop end
    (setq N1 (1+ N1))
  )                                        ;outer loop end
(print pts)
  (while
    (or        (= (setq A (entsel "\n选取要修改的统计文字: ")) NIL)
        (/= "TEXT" (cdr (assoc 0 (entget (car A)))))
    )
  )
  (setq A (entget (car A)))
  (entmod (subst (cons 1 (RTOS (length PTS))) (assoc 1 A) A))
  (setvar "OSMODE" HOLDOSMODE)
  (command "_.UNDO" "_END")
  (princ)
)