|
|
发表于 2003-3-24 08:05:00
|
显示全部楼层
再试试!! 只处理"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
) |
|
置顶卡
