龙大侠请关注~

hlzhong

不知龙大侠关于循环选择程序和透视程序的嵌套可有进展，，小弟实是一时难以实现，还请赐教，谢谢了！

龙龙仔

再试试!! 只处理"polyline,line,lwpolyline,3dface,region"直线,含ARC的线不处理
;;注意:只处理"polyline,line,lwpolyline,3dface,region"直线,含ARC的线不处理
(defun C:TT (/ SS SS1 N N1 NN ENT CHECK TMP PT_LIST)

  (defun DO_IT (TMP)
    (if
      (and
        (not (equal (car TMP) (cadr TMP)))
        (= (vl-position TMP PT_LIST) NIL)
        (= (vl-position (list (cadr TMP) (car TMP)) PT_LIST) NIL)
      )
       (setq PT_LIST (append PT_LIST (list TMP)))
    )
  )

  (defun DO_IT1        (ENT / TMP)
    (setq TMP (list (cdr (assoc 10 ENT))
                    (cdr (assoc 11 ENT))
              )
    )
    (DO_IT TMP)
  )

  (setq SS (ssget '((0 . "polyline,line,lwpolyline,3dface,region"))))
  (setq PT_LIST '())
  (setq N 0)
  (repeat (sslength SS)
    (setq ENT (ssname SS N))
    (setq CHECK (cdr (assoc 100 (reverse (entget ENT)))))
    (cond
      ((or (= CHECK "AcDbPolygonMesh") (= CHECK "AcDbFace"))
       (if (= CHECK "AcDbPolygonMesh")
         (progn
           (command "_.COPY" ENT "" "0,0" "@")
           (command "_.EXPLODE" (entlast))
           (setq SS1 (ssget ""))
         )
         (progn (setq SS1 (ssadd)) (ssadd ENT SS1))
       )
       (setq N1 0)
       (repeat (sslength SS1)
         (setq ENT (entget (ssname SS1 N1)))
         (setq NN 0)
         (setq LINE0 (list (cdr (assoc 10 ENT))
                           (cdr (assoc 11 ENT))
                     )
               LINE1 (list (cdr (assoc 11 ENT))
                           (cdr (assoc 12 ENT))
                     )
               LINE2 (list (cdr (assoc 12 ENT))
                           (cdr (assoc 13 ENT))
                     )
               LINE3 (list (cdr (assoc 13 ENT))
                           (cdr (assoc 10 ENT))
                     )
         )
         (repeat 4
           (setq TMP (eval (read (strcat "LINE" (rtos NN)))))
           (DO_IT TMP)
           (setq NN (1+ NN))
         )
         (setq N1 (1+ N1))
       )
       (command "_.ERASE" SS1 "")
      )
      ((or (= CHECK "AcDb3dPolyline")
           (= CHECK "AcDb2dPolyline")
           (= CHECK "AcDbPolyline")
           (= CHECK "AcDbModelerGeometry")
       )
       (command "_.COPY" ENT "" "0,0" "@")
       (command "_.EXPLODE" (entlast))
       (setq SS1 (ssget ""))
       (setq N1 0)
       (repeat (sslength SS1)
         (setq ENT (ssname SS1 N1))
         (DO_IT1 (entget ENT))
         (setq N1 (1+ N1))
       )
       (command "_.ERASE" SS1 "")
      )
      (t
       (DO_IT1 (entget ENT))
      )
    )
    (setq N (1+ N))
  )
  ;(command "_.ERASE" SS "")
  PT_LIST
)

hlzhong

hlzhong

非常感谢龙龙仔大侠，可以了，我从你返回的PT_LIST表中很方便地得到了所需的顶点坐标。[br]