用draworder过度杀戮，只是
大家好，我正在寻找一些“简单”的代码，根据draworder删除重复的直线和圆弧。我需要该程序始终保持'上'行和删除重复。常规的过度杀戮并不奏效，因为复制品位于不同的层上。
目前，我使用下面的代码，但过程需要很长时间，我希望能找到下面代码的更“简单”的版本。
我希望有人能帮我解决这个问题。。。
(defun KGA_Block_DrawOrder (blkObj / sortArr sortTblObj)
(if
(and
(= :vlax-true (vla-get-hasextensiondictionary blkObj))
(setq sortTblObj (KGA_Sys_Apply 'vla-item (list (KGA_Data_ObjectExtDictGet blkObj) "ACAD_SORTENTS")))
)
(progn
(vla-getfulldraworder sortTblObj 'sortArr :vlax-false)
(mapcar 'vlax-variant-value (vlax-safearray->list sortArr)) ; Last is the top of the draworder.
)
)
)
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
(if ss
(repeat (setq i (sslength ss))
(setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
)
)
)
(defun KGA_Data_ObjectExtDictGet (object)
(if (= :vlax-true (vla-get-hasextensiondictionary object))
(vla-getextensiondictionary object)
)
)
; Make a zero based list of integers.
; With speed improvement based on Reini Urban's (std-%setnth).
; (KGA_List_IndexSeqMakeLength 7) => (0 1 2 3 4 5 6)
(defun KGA_List_IndexSeqMakeLength (len / ret)
(repeat (rem len 4)
(setq ret (cons (setq len (1- len)) ret))
)
(repeat (/ len 4)
(setq ret
(vl-list*
(- len 4)
(- len 3)
(- len 2)
(- len 1)
ret
)
)
(setq len (- len 4))
)
ret
)
(defun KGA_Sys_Apply (expr varLst / ret)
(if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
ret
)
)
(defun KGA_Sys_ObjectOwner (obj)
(vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)
(defun BKG_OverkillEqual(ss seg fuzz
/ N_Equal_P N_EqualPoints_P N_PointList
curveALst datLst delA_P idxLst n ordLst ptsLst
)
(defun N_Equal_P (curveALst curveBLst) ; Format of lists: (staPt endPt objNme obj).
(cond
(
(and
(equal (car curveALst) (car curveBLst) fuzz) ; Sta = Sta.
(equal (cadr curveALst) (cadr curveBLst) fuzz) ; End = End.
)
(if (= "AcDbLine" (caddr curveALst) (caddr curveBLst))
T
(N_EqualPoints_P (cadddr curveALst) (cadddr curveBLst) nil)
)
)
(
(and
(equal (car curveALst) (cadr curveBLst) fuzz); Sta = End.
(equal (cadr curveALst) (car curveBLst) fuzz); End = Sta.
)
(if (= "AcDbLine" (caddr curveALst) (caddr curveBLst))
T
(N_EqualPoints_P (cadddr curveALst) (cadddr curveBLst) T)
)
)
)
)
(defun N_EqualPoints_P (objA objB revB_P / ptsA ptsB)
(setq ptsA (cond ((cadr (assoc objA ptsLst))) ((N_PointList objA))))
(setq ptsB (cond ((cadr (assoc objB ptsLst))) ((N_PointList objB))))
(if revB_P
(equal ptsA (reverse ptsB) fuzz)
(equal ptsA ptsB fuzz)
)
)
(defun N_PointList (obj / pts size) ; Output does not include start and end point.
(setq size (/ (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) seg))
(setq pts
(mapcar
'(lambda (idx) (vlax-curve-getpointatdist obj (* idx size)))
idxLst
)
)
(setq ptsLst (cons (list obj pts) ptsLst))
pts
)
(setq idxLst (cdr (KGA_List_IndexSeqMakeLength seg))) ; Used by N_PointList.
;; For "_X" and "_A" sets the last created object is the first in datLst.
;; This is the top of the draworder if ordLst is nil.
(setq datLst (KGA_Conv_Pickset_To_ObjectList ss))
(setq ordLst (reverse (KGA_Block_DrawOrder (KGA_Sys_ObjectOwner (car datLst))))) ; First is the top of the draworder.
(setq datLst
(vl-remove
nil
(mapcar
'(lambda (obj / onm)
(if
(and
(vlax-write-enabled-p obj)
(vl-position
(setq onm (vla-get-objectname obj))
'("AcDb2dPolyline" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbLine" "AcDbPolyline" "AcDbSpline")
)
)
(list
(vlax-curve-getstartpoint obj)
(vlax-curve-getendpoint obj)
onm
obj
)
)
)
datLst
)
)
)
(setq n 0)
(while (cadr datLst)
(setq delA_P nil)
(setq curveALst (car datLst))
(foreach curveBLst (setq datLst (cdr datLst))
(if (N_Equal_P curveALst curveBLst)
(if
(or
(not ordLst)
(< (vl-position (cadddr curveALst) ordLst) (vl-position (cadddr curveBLst) ordLst))
)
(progn
(setq datLst (vl-remove curveBLst datLst))
(vla-delete (cadddr curveBLst))
(setq n (1+ n))
)
(setq delA_P T) ; Don't delete curve A just yet.
)
)
)
(if delA_P
(progn
(vla-delete (cadddr curveALst))
(setq n (1+ n))
)
)
)
n ; Return total deleted entities.
)
页:
[1]