归范化多义线

王咣生

;;;------------------------------------------------------------------------;;;
;;; 归范化多义线 ;;;
;;; 1. 消除折环 ;;;
;;; 2. 消除冗余结点 ;;;
;;;------------------------------------------------------------------------;;; ;;; http://devcad.vicp.net (vl-load-com) (defun c:test ( / old_osmd sset len i item lst coords name ssp txtobj
retlst ptcur pt j pti)
(setq old_osmd (getvar "osmode"))
(setvar "osmode" 0)

(vla-ZoomExtents (vlax-get-acad-object))

(setq sset (ssget "x" (list
(cons -4 "<or")
(cons -4 "<and")
(cons 0 "LWPOLYLINE")
(cons -4 "and>")
(cons -4 "<and")
(cons 0 "POLYLINE")
(cons -4 "and>")
(cons -4 "or>")
)
))
(setq len (sslength sset)) (setq i 0)
(repeat len
(setq ename (ssname sset i))
(setq item (vlax-ename->vla-object ename))
;取得多义线坐标
(setq lst (vlax-safearray->list
(vlax-variant-value
(vlax-get-property item 'Coordinates))
)
)

(setq coords nil)
(if (= (vlax-get-property item 'ObjectName) "AcDb2dPolyline")
(progn
(while lst
(if (= coords nil)
(setq coords (list (list (nth 0 lst) (nth 1 lst))) )
(setq coords (append coords (list (list (nth 0 lst) (nth 1 lst)))))
)
(setq lst (cdr (cdr (cdr lst))))
)
)
)

(if (= (vlax-get-property item 'ObjectName) "AcDbPolyline")
(progn
(while lst
(if (= coords nil)
(setq coords (list (list (nth 0 lst) (nth 1 lst))) )
(setq coords (append coords (list (list (nth 0 lst) (nth 1 lst)))))
)
(setq lst (cdr (cdr lst)))
)
)
)
;处理坐标coords
(setq lastpt (car (reverse coords))) ;提取最后一个结点坐标
(setq coords (reverse (cdr (reverse coords)))) ;从coords中删除最后一个结点坐标 ;构建新的坐标表
(setq retlst nil)
(while coords
(if (= retlst nil)
(setq retlst (list (nth 0 coords) )) ;提取第一个点
(progn
(setq ptcur (nth 0 coords))
;判断pt是否已经在retlst中,若为F,加入到retlst
(setq exist nil j 0)
(while (setq pt (nth j retlst))
;ptcur与pt和lastpt比较
(if (or (and (= (nth 0 ptcur) (nth 0 pt)) (= (nth 1 ptcur) (nth 1 pt)))
(and (= (nth 0 ptcur) (nth 0 lastpt)) (= (nth 1 ptcur) (nth 1 lastpt)))
)
(setq exist t)
);
(setq j (+ j 1))
);while

;
(if (not exist)
(setq retlst (append retlst (list ptcur)))
)
);progn
);if
(setq coords (cdr coords))
) (setq retlst (append retlst (list lastpt))) ;判断是否封闭
(setq closed nil)
(vlax-dump-object item t)
(if (vlax-property-available-p item 'Closed)
(setq closed (vlax-get-property item 'Closed))
)

;绘新多义线
(command "pline")
(foreach pti retlst (command pti))
(if (= closed :vlax-true)
(command "C" "")
(command "" "")
)

(command) ;属性匹配
(command "matchprop" ename (entlast) "") ;删除线对象
(vlax-invoke-method item 'Delete) (setq i (+ i 1))
(grtext -1 (itoa i))
);repeat (setvar "osmode" old_osmd) (grtext -1 "OK")
(princ "\nOK!")
(alert "OK!")
(grtext -1 "")
(princ)
);defun

无痕

好像只是专门对付闭合冗余结点的，对么？



看上去只是处理了第一和最末尾的点



试了一下，曲线段都变成直的了：（

王咣生

是, 有些方法给初学者借鉴吧.