|
|
发表于 2002-8-8 07:55:00
|
显示全部楼层
;;;这是一个求交点的程序
;;;如何统计一区域内（两点确定的矩形范围）
;;;图层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 (vla-object AOBJ1)
N2 (1+ N1)
) ;index for inner loop
;;; Inner loop, go through remaining objects
(while (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)
) |
|
置顶卡
