正位于ano顶部的多段线
在我的DWG文件中存在（多段线正好位于另一条多段线的顶部）。我需要找到包含多段线副本的多段线，
这是一条多段线被复制并粘贴在同一条多段线上
有什么帮助吗？ 命令：Overkill
亨里克 我需要向系统操作员展示一条重叠的多段线，即它的相同副本。
!!!!复制并粘贴多段线时，她将在原始多段线上进行检查
他接到复制和粘贴的命令，有时忘记了操作员
留下了两条折线，一条在另一条上，必须警告他。 使用下面链接中提供的lisp例程查找重复实体。
http://autolispindia.blogspot.com/2012/10/find-duplicate-entities-obects-in.html 我的互联网屏蔽了这个网站（博客），你可以复制代码吗？
;start copy form here
; Loads Visual LISP extensions to AutoLISP
(vl-load-com)
;; this will cll the fiu
(defun C:Dup()
(duplicateentities)
)
;this is the main function to find duplicate entities/Objects in Autocad
;this is very fast method
;this will catch duplicate entities like Blocks,Point,Line only
;this will not apply for polyline,Lwpolyline
(defun duplicateentities (/ $acad $adoc $mspa ent objname ins bname stp enp lay errcnt)
(setq $acad (vlax-get-acad-object)
$adoc (vla-get-activedocument $acad)
$mspa (vlax-get-property $adoc 'modelspace)
errcnt 0
) ;_ end of setq
(vlax-for obj $mspa
(setq ent (vlax-vla-object->ename obj)
objname (vlax-get-property obj 'objectname)
) ;_ end of setq
(cond
((eq objname "AcDbBlockReference")
(setq ins (vlax-get obj 'insertionpoint)
bname (vlax-get obj 'name)
) ;_ end of setq
(if (> (sslength (ssget "x" (list (cons 2 bname) (cons 10 ins)))) 1)
(progn
(markerror ent (strcat "Duplicate objects found [" bname "]") nil)
(setq errcnt (1+ errcnt))
) ;_ end of progn
) ;_ end of if
)
((eq objname "AcDbPoint")
(setq ins (vlax-get obj 'Coordinates))
lay (vlax-get obj 'layer)
(if (> (sslength (ssget "x" (list (cons 0 "POINT") (cons 10 ins)))) 1)
(progn
(markerror ent (strcat "Duplicate objects found [" lay "]") nil)
(setq errcnt (1+ errcnt))
) ;_ end of progn
) ;_ end of if
)
((eq objname "AcDbLine")
(setq stp (vlax-get obj 'startpoint)
enp (vlax-get obj 'endpoint)
lay (vlax-get obj 'layer)
) ;_ end of setq
(if (> (sslength (ssget "x" (list (cons 10 stp) (cons 11 enp)))) 1)
(progn
(markerror ent (strcat "Duplicate objects found [" lay "]") nil)
(setq errcnt (1+ errcnt))
) ;_ end of progn
) ;_ end of if
)
) ;_ end of cond
) ;_ end of VLAX-FOR
) ;_ end of defun
;it will mark error (place circle in error layer) in model
(defun markerror (e er f / el etyp handle ip)
(setq el (entget e)
etyp (strcase (cdr (assoc 0 el)))
handle (cdr (assoc 5 el))
ip (cond
((wcmatch etyp "*LINE")
(vlax-get-midpoint e)
)
(t
(cdr (assoc 10 el))
)
) ;_ end of cond
) ;_ end of setq
(entmake
(list (cons 0 "circle") (cons 8 "Error") (cons 10 ip) (cons 62 2) (cons 40 15))
) ;_ end of entmake
(if f
(write-line (strcat er " For object " handle) f)
) ;_ end of if
) ;_ end of defun
;this function will get mid point for LINE,POLYLINE,LWPOLYLINE
(defun vlax-get-midpoint (e / ve)
(setq ve (vlax-ename->vla-object e))
(if (= (vlax-curve-getendparam ve) 0)
(vlax-curve-getstartpoint ve)
(vlax-curve-getpointatdist
ve
(/ (vlax-curve-getdistatparam ve (vlax-curve-getendparam ve)) 2)
)
)
) ;_ end of defun
Kullaireddy Tadipatri发布的lisp代码
HTH公司
Espero ter ajudado。
页:
[1]