归范化多义线
;;;------------------------------------------------------------------------;;;<BR>;;; 归范化多义线 ;;;<BR>;;; 1. 消除折环 ;;;<BR>;;; 2. 消除冗余结点 ;;;<BR>;;;------------------------------------------------------------------------;;;;;; <A href="http://devcad.vicp.net/" target="_blank" >http://devcad.vicp.net</A>
(vl-load-com)
(defun c:test ( / old_osmd sset len i item lst coords name ssp txtobj<BR> retlst ptcur pt j pti)<BR> (setq old_osmd (getvar "osmode"))<BR> (setvar "osmode" 0)<BR> <BR> (vla-ZoomExtents (vlax-get-acad-object))<BR> <BR> (setq sset (ssget "x" (list<BR> (cons -4 "<or")<BR> (cons -4 "<and")<BR> (cons 0 "LWPOLYLINE")<BR> (cons -4 "and>")<BR> (cons -4 "<and")<BR> (cons 0 "POLYLINE")<BR> (cons -4 "and>")<BR> (cons -4 "or>")<BR> )<BR> ))<BR> (setq len (sslength sset))
(setq i 0)<BR> (repeat len<BR> (setq ename (ssname sset i))<BR> (setq item (vlax-ename->vla-object ename))<BR> ;取得多义线坐标<BR> (setq lst (vlax-safearray->list<BR> (vlax-variant-value<BR> (vlax-get-property item 'Coordinates))<BR> )<BR> )<BR> <BR> (setq coords nil)<BR> (if (= (vlax-get-property item 'ObjectName) "AcDb2dPolyline")<BR> (progn<BR> (while lst<BR> (if (= coords nil)<BR> (setq coords (list (list (nth 0 lst) (nth 1 lst))) )<BR> (setq coords (append coords (list (list (nth 0 lst) (nth 1 lst)))))<BR> )<BR> (setq lst (cdr (cdr (cdr lst))))<BR> )<BR> )<BR> )<BR> <BR> (if (= (vlax-get-property item 'ObjectName) "AcDbPolyline")<BR> (progn<BR> (while lst<BR> (if (= coords nil)<BR> (setq coords (list (list (nth 0 lst) (nth 1 lst))) )<BR> (setq coords (append coords (list (list (nth 0 lst) (nth 1 lst)))))<BR> )<BR> (setq lst (cdr (cdr lst)))<BR> )<BR> )<BR> )<BR> ;处理坐标coords<BR> (setq lastpt (car (reverse coords))) ;提取最后一个结点坐标<BR> (setq coords (reverse (cdr (reverse coords)))) ;从coords中删除最后一个结点坐标
;构建新的坐标表<BR> (setq retlst nil)<BR> (while coords<BR> (if (= retlst nil)<BR> (setq retlst (list (nth 0 coords) )) ;提取第一个点<BR> (progn<BR> (setq ptcur (nth 0 coords))<BR> ;判断pt是否已经在retlst中,若为F,加入到retlst<BR> (setq exist nil j 0)<BR> (while (setq pt (nth j retlst))<BR> ;ptcur与pt和lastpt比较<BR> (if (or (and (= (nth 0 ptcur) (nth 0 pt)) (= (nth 1 ptcur) (nth 1 pt)))<BR> (and (= (nth 0 ptcur) (nth 0 lastpt)) (= (nth 1 ptcur) (nth 1 lastpt)))<BR> )<BR> (setq exist t)<BR> );<BR> (setq j (+ j 1))<BR> );while<BR> <BR> ;<BR> (if (not exist)<BR> (setq retlst (append retlst (list ptcur)))<BR> )<BR> );progn<BR> );if<BR> (setq coords (cdr coords))<BR> )
(setq retlst (append retlst (list lastpt)))
;判断是否封闭<BR> (setq closed nil)<BR> (vlax-dump-object item t)<BR> (if (vlax-property-available-p item 'Closed)<BR> (setq closed (vlax-get-property item 'Closed))<BR> )<BR> <BR> ;绘新多义线<BR> (command "pline")<BR> (foreach pti retlst (command pti))<BR> (if (= closed :vlax-true)<BR> (command "C" "")<BR> (command "" "")<BR> )<BR> <BR> (command)
;属性匹配<BR> (command "matchprop" ename (entlast) "")
;删除线对象<BR> (vlax-invoke-method item 'Delete)
(setq i (+ i 1))<BR> (grtext -1 (itoa i))<BR> );repeat
(setvar "osmode" old_osmd)
(grtext -1 "OK")<BR> (princ "\nOK!")<BR> (alert "OK!")<BR> (grtext -1 "")<BR> (princ)<BR>);defun<BR>
好像只是专门对付闭合冗余结点的，对么？
看上去只是处理了第一和最末尾的点
试了一下，曲线段都变成直的了：（
回复
是, 有些方法给初学者借鉴吧.
页:
[1]