那位大虾能给帮忙编一个提取二维平面图形中所有实交点坐标的程序？急用！！

lohelen2001

那位大虾能给帮忙编一个提取二维平面图形中所有实交点坐标的程序？

matichen

龙龙仔

;;-----------------------------------------------
;; 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 N NN HOLDOSMODE
                  )
  (vl-load-com)
  (command "_.UNDO" "_GROUP")
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq SS (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
  (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)
  (setvar "OSMODE" HOLDOSMODE)
  (command "_.UNDO" "_END")
  (princ)
)

lohelen2001

多谢，多谢！以后还望多多指教！能不能告所我你的e-mail我得
lohelen2001◎163.com
还有一个问题，能不能把坐标输入dat一个文件中，并按坐标排序！！
是不是有点过分！！
看来，不学lisp是不行了，请给指教一本教材吧？

lohelen2001

能不能把坐标输入dat文件并排序？

龙龙仔

lohelen2001

我想先以x坐标排序，再以y，最后以z
输出的dat文件
最好是每个点x，y，z在一行
但x，y，z的位置最好是都在一列上，这样可以方便的列选

秋枫

(defun Sort_and_Write_pList (fname plist / fp pt)
  ;; sort plist first
  (setq        plist (vl-sort plist
                       '(lambda        (p1 p2)
                          (cond        ((< (car p1) (car p2)) T)
                                ((and (= (car p1) (car p2))
                                      (< (cadr p1) (cadr p2))
                                 )
                                 T
                                )
                                ((and (= (car p1) (car p2))
                                      (= (cadr p1) (cadr p2))
                                      (< (caddr p1) (caddr p2))
                                 )
                                 T
                                )
                                (T nil)
                          )
                        )
              )
  )
  ;; write plist then
  (setq fp (open fname "w"))
  (foreach pt plist (princ pt fp) (princ "\n" fp))
  (close fp)
)

;;;　测试上述函数
(Sort_and_Write_pList
  "c:/test.txt"
  '((1 3 4)
    (2 4 5)
    (3 4 5)
    (1 3 2)
    (3 5 2)
    (2 4 0)
    (1 2 3)
    (1 2 0)
    (1 1 0)
   )
)
下载：

运行结果：c:\test.txt中内容
(1 1 0)
(1 2 0)
(1 2 3)
(1 3 2)
(1 3 4)
(2 4 0)
(2 4 5)
(3 4 5)
(3 5 2)

lohelen2001

得各位大虾指点，小弟受益匪浅！不胜感激

dkj0322

谢谢楼上的分享，参考下，很感激