subtracting vertices of group of polylines

Code Red > AutoLISP (Vanilla / Visual)

(1/3) > >>

bprabhakar001:
Dear All,

I have a written a program to identify the vertices which are not identical from overlapping each polylines.
But it gives peculate result. I did not have where exactly problem exist.
Would you please some one help me to rectify the problem. And also I requesting you please suggest the method to solve this. Because if the dwg having more data it was taking couple of processing time some time hanging also.
I am very glad to here the corrections.

Thanking U,
Prabhakar.B

<contact information removed>

ElpanovEvgeniy:

--- Code: ---(defun c:test-lw (/ a1 a2 l)
(if (and (setq a1 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails Routes_*"))))
(setq a2 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails_*"))))
) ;_ and
(progn
(setq a1 (mapcar (function cadr) (ssnamex a1))
a2 (mapcar (function cadr) (ssnamex a2))
) ;_ setq
(progn
(foreach x a1
(foreach x1 a2
(if
(and (equal (distance (vlax-curve-getclosestpointto x (vlax-curve-getStartPoint x1))
(vlax-curve-getStartPoint x1)
) ;_ distance
0.
1e-8
) ;_ equal
(equal (distance (vlax-curve-getclosestpointto x (vlax-curve-getEndPoint x1))
(vlax-curve-getEndPoint x1)
) ;_ distance
0.
1e-8
) ;_ equal
) ;_ and
(progn
(setq a2 (vl-remove x1 a2))
(foreach x2 (mapcar
(function cdr)
(vl-remove-if-not (function (lambda (b) (= (car b) 10))) (entget x1))
) ;_ mapcar
(if (not (equal (distance (vlax-curve-getclosestpointto x x2) x2)
0.
1e-8
) ;_ equal
) ;_ not
(setq l (cons x2 l))
) ;_ if
) ;_ foreach
) ;_ progn
) ;_ if
) ;_ foreach
) ;_ foreach
(foreach x a1
(foreach x2 l
(if (equal (distance (vlax-curve-getclosestpointto x x2) x2) 0. 1e-8)
(setq l (vl-remove x2 l))
) ;_ if
) ;_ foreach
) ;_ foreach
(foreach x l
(entmakex
(list
'(0 . "CIRCLE")
'(8 . "ERROR-DIST")
'(62 . 1)
(cons 10 x)
'(40 . 0.0005)
) ;_ list
) ;_ entmakex
) ;_ foreach
) ;_ progn
) ;_ progn
) ;_ if
(princ)
)
--- End code ---

CAB:
Evgeniy you beat me to it. :)

Here is my attempt.

--- Code: ---(defun c:ver (/ echo osmode)
(vl-load-com)

(defun getlwpolylinecoords (ent / idx pt result)
(setq idx -1)
(while (setq pt (vlax-curve-getpointatparam ent (setq idx (1+ idx))))
(setq result (cons pt result))
)
(reverse result)
)

(defun get_vertex (lyr / ss coor result)
(if (setq ss (ssget "_X" (list '(0 . "POLYLINE,LWPOLYLINE") (cons 8 lyr))))
(mapcar '(lambda (x)
(if (setq coor (getlwpolylinecoords x))
(if result
(setq result (append coor result))
(setq result coor)
)
)
)
(mapcar 'cadr
(ssnamex ss)
)

)
)
result
)

;; Subtract two point list given a max distance
;; CAB 08/26/2006
(defun return_unique_points (lst1 lst2 max_distance / tmp)
(setq tmp lst2)
(mapcar
'(lambda (x)
(setq lst2 (vl-remove-if '(lambda (y) (< (distance x y) max_distance)) lst2))
)
lst1
)
(mapcar
'(lambda (x)
(setq lst1 (vl-remove-if '(lambda (y) (< (distance x y) max_distance)) lst1))
)
tmp
)
(append lst2 lst1)
)

(defun mark (lst r)
(mapcar
'(lambda (pt)
(entmake
(list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "ERROR")
(cons 10 pt)
(cons 40 r)
(cons 62 1) ; RED
(cons 210 (list 0.0 0.0 1.0))
)
)
)
lst
)
)

;;------------------------------------------
;; Begin Here
;;------------------------------------------

(command "undo" "be")
(setq echo (getvar "cmdecho")
osmode (getvar "osmode")
)
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)

(setq rad 0.0004) ; Circle for test
(setq max_dist 0.0000001) ; ** max distance for error of points

(if
(and
(or (setq trail (get_vertex "*TRAIL*"))
(prompt "\nNo trail features selected\n")
)
(or (setq route (get_vertex "*ROUTE*"))
(prompt "\nNo route features selected\n")
)
)
(progn
(prompt "\n * * * Working, Please Wait........\n")
(if (setq mis_match (return_unique_points trail route max_dist))
(mark mis_match rad)
)
)
)
(setvar "CMDECHO" echo)
(setvar "OSMODE" osmode)
(command "undo" "end")
(princ)
)
;;===============================================================================;;

(repeat 3 (print))
(princ
"\n\t\lsp loaded.............Proceed with \"VER\"."
)
(princ)
--- End code ---

ElpanovEvgeniy:

--- Quote from: CAB on August 26, 2006, 11:18:34 AM ---Evgeniy you beat me to it. :)

Here is my attempt.

--- End quote ---

Excuse! I did not wish to offend. :-(
I probably have hastened, I needed to wait for all a floor of hour...

CAB:
Evgeniy
You did not offend me. I was joking around.
I enjoy all your post and learn from them, thanks for participating, and keep up the good work.

Alan

Navigation

[0] Message Index

[#] Next page

Go to full version