Jump to content

HELP: Any LISP to remove all the points/vertices of a polyline


vernonlee

Recommended Posts

Any LISP with window selection to remove all the points/vertices of the polyline. They are all hidden line type but due to the closeness of the points/vertices the hidden line are not appearing.

 

Currently using "REMOVECONTROLPOINT" but I need to click 1 by 1 & further more i am not sure why but if i am not quick enough to move away from the polyline after clicking it, autocad will sometimes hang.

 

Attached a sample for advise.

 

polyline.dwg

 

Thanks

Link to comment
Share on other sites

Those lwpolylines probably are created as parts of SuperEllipses... As SuperEllipse don't belong to 2nd degree curves, it's difficult to make exact conversion to curve with smaller number of vertices, so I figured that the best would be for you to recreate arcs/elliptical or circular, and as you want to have lwpolyline entities so that conversion would be closest matched, I've recreated arcs - circular... You only have to do PEDIT on them all and you'll get lwpolylines... All my functions from PLINETOOLS won't help in this situations as like I said obtained segmented lwpolylines probably belong to curve 3rd degree - like planar SPLINE or SuperEllipse...

 

See attachment - it was very simple - just draw arc with 3 points (1st click on 1st end, then type "s" second point - click on vertex in between, and 3rd click on last end)

 

M.R.

polyline.dwg

Link to comment
Share on other sites

Hi marko,

 

appreciate the help. i took a look at the dwg. I need the line to be exactly in the same location which the created arc is not.

 

Btw, have you tried REMOVECONTROLPOINT command. Think that would be faster than redrawing an arc.

I do need some where i can select all this line instead of repeating the command for every lines. My sample dwg is just a small portion only. Have alot more such lines unfortunately

Link to comment
Share on other sites

Look vermonlee, maybe it is 2nd degree curve... Closest match I've made is parabola... Look in attached DWG... If you have plenty of this kind of lwpolylines, and you want to get rid of their vertices, I suggest that you analyze curvature and create appropriate SPLINE replacement... And as you can see from attachment, there are still some unmatched vertex relations between 2nd degree curve and your lwpolyline... I know this is very difficult to do without routine, but I think that if you have like this example lwpolylines, I am afraid you'll have to do it manually... How would you make match if you use REMOVECONTROLPOINT command, when with every deletion of vertex your lwpoly will degrade from it's initial curving representation...

 

For drawing ellipse, look here :

http://www.theswamp.org/index.php?topic=40414.msg457331#msg457331

(use colored code and apply it on only quarter of full ellipse - you'll have to prepare elliptic arc - you must trim ellipse)

When you create appropriate spline substitution for this quarter ellipse, you have to go to properties palette, switch to 2nd control point and change weight of that control point - you will get something like SuperEllipse approximations...

 

For drawing parabolas, hyperbolas, look here :

http://www.theswamp.org/index.php?topic=48929.msg540574#msg540574

 

You have to find appropriate match manually - that's my opinion... And with REMOVECONTROLPOINT you'll just destroy original lwpolyline curvature...

Look in attachment...

polyline.dwg

Link to comment
Share on other sites

When I think twice and realize that you'll have to do lwpolyline -> spline conversion, you can use CVREBUILD command and set appropriate conversion options and directly remove unwanted control points - you can specify amount as you wish and degree of resulting curve rebuilding...

 

HTH, M.R.

Link to comment
Share on other sites

When I think twice and realize that you'll have to do lwpolyline -> spline conversion, you can use CVREBUILD command and set appropriate conversion options and directly remove unwanted control points - you can specify amount as you wish and degree of resulting curve rebuilding...

 

HTH, M.R.

 

This is a pretty good solution over removecontrolpoint. I still cannot select all line but 1 by 1 but at least it is slightly faster & does not hang. Thanks for the tip.

 

I will use CVREBUILD for now untill a better solution comesup where more lines can be selected.

Link to comment
Share on other sites

Just an update.

 

I accidently found out by changing the properties of the linetype genenator to ENABLE it also works. I now can now just select all affected line & change the properties.

Link to comment
Share on other sites

Any LISP with window selection to remove all the points/vertices of the polyline. They are all hidden line type but due to the closeness of the points/vertices the hidden line are not appearing.

 

Currently using "REMOVECONTROLPOINT" but I need to click 1 by 1 & further more i am not sure why but if i am not quick enough to move away from the polyline after clicking it, autocad will sometimes hang.

 

Attached a sample for advise.

 

[ATTACH]53188[/ATTACH]

 

Thanks

 

Im using this one. very good routine

 


;;;=======================[ PSimple.lsp ]======================= 
;;; 
Author: Charles Alan Butler 
;;; Version:  1.7 Nov. 24, 2007
;;; 
Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and 
varying 
widths
;;;=============================================================
;; 
This version will remove the first vertex if it is colinear
;; and first 
& last arcs that have the same center


;;  command line entry, user selection set pick
(defun c:PSimple () 
(PSimpleUser nil)(princ))
(defun c:PSimpleV () ; Verbose version
 
(mapcar '(lambda(x)(print (car x))(princ (cadr x))) (PSimpleUser nil))
 
(princ)
)


;;  User interface Function
;;  flag = nil -> user selects a 
selection set
;;       = ENAME -> call the 
routine
;;       = OBJECT -> call the 
routine
;;       = True   -> User 
to select a single entity, repeats
(defun PSimpleUser (flag / ss 
ent)
 (cond
   ((null flag)    ; user 
selection set pick
    (prompt "\n Select polylines to 
remove extra vertex: ")
    (if (setq ss (ssget '((0 . 
"LWPOLYLINE"))))
      (PSimple 
ss)
    )
   )
   
;;  next two already have an object so pass to the main 
routine
   ((= (type flag) 'ENAME) (PSimple 
flag))
   ((= (type flag) 'VLA-object) (PSimple 
flag))
   (t  ; user single pick with 
repeat
      
(while
        (setq ent (car 
(entsel "\n Select polyline to remove extra vertex: 
")))
         (if (equal (assoc 
0 (entget ent)) '(0 . 
"LWPOLYLINE"))
           
(PSimple 
ent)
           
(prompt "\nNot a LWPolyline, Try 
again.")
         
)
      )
   )
 
)
)








;;;=======================[ PSimple.lsp ]======================= 
;;; 
Author: Charles Alan Butler 
;;; Version:  1.7 Nov. 23, 2007
;;; 
Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and 
varying 
widths
;;;=============================================================
;; 
This version will remove the first vertex if it is colinear
;; and first 
& last arcs that have the same center
;; Open plines that have the same 
start & end point will be closed


;;  Argument: et
;;    may be an ename, Vla-Object, 
list of enames or
;;    a selection set
;;  Returns: a 
list, (ename message)
;;    Massage is number of vertex 
removed or error message string
;;    If a list or selection 
set a list of lists is returned
(defun PSimple (et / doc result Tan Replace 
BulgeCenter RemoveNlst ps1)
 (vl-load-com)


 (defun tan (a) (/ (sin a) (cos a)))


 (defun replace (lst i itm)
   (setq i (1+ 
i))
   (mapcar '(lambda (x) (if (zerop (setq i (1- i))) itm 
x)) lst)
 )


 
 ;;  CAB 11.16.07
 ;;  Remove based on 
pointer list
 (defun RemoveNlst (nlst lst)
   (setq 
i -1)
   (vl-remove-if  '(lambda (x) (not (null 
(vl-position (setq i (1+ i)) nlst)))) lst)
 )
 
 
(defun BulgeCenter (bulge p1 p2 / delta chord radius 
center)
   (setq delta  (* (atan bulge) 
4)
         chord  
(distance p1 p2)
         
radius (/ chord (sin (/ delta 2)) 
2)
         center (polar p1 (+ 
(angle p1 p2) (/ (- pi delta) 2)) radius)
   )
 
)


 ;;  Main function to remove vertex
 ;;  ent must be 
an ename of a LWPolyline
 (defun ps1 (ent 
/      aa     cpt    
dir    doc    elst   hlst   
Remove
                 
idx    keep   len    newb   
result vlst   x      
closed
                 
d10    d40    d41    
d42    hlst   p1     
p2     
p3
                 
plast  msg)
     
;;=====================================================
     
(setq elst (entget 
ent)
           
msg  "")
     (setq d10 (mapcar 'cdr 
(vl-remove-if-not '(lambda (x) (= (car x) 10)) 
elst)))
     (if (> (length d10) 
2)
       
(progn
         ;;  
seperate vertex data
         
(setq d40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) 
elst))
         (setq d41 
(vl-remove-if-not '(lambda (x) (= (car x) 41)) 
elst))
         (setq d42 
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) 
elst)))
         ;;  
remove extra vertex from point 
list
         (setq plast (1- 
(length d10)))
         (setq 
p1 0  p2 1  p3 
2)
         (if (and (not (setq 
closed (vlax-curve-isclosed 
ent)))
                  
(equal (car d10) (last d10) 
1e-6))
           
(progn
             
(setq Closed t ; close the 
pline
                   
elst (subst (cons 70 (1+(cdr(assoc 70 elst))))(assoc 70 elst) 
elst)
                   
msg  " Closed 
and")
             
(if (and (not(zerop (nth plast d42)))(not(zerop (nth 0 
d42))))
               
(setq d10 (reverse(cdr(reverse 
d10)))
                     
d40 (reverse(cdr(reverse 
d40)))
                     
d41 (reverse(cdr(reverse 
d41)))
                     
d42 (reverse(cdr(reverse 
d42)))
                     
plast (1- 
plast)
               
)
             
)
           
)
         
)
         (setq idx 
-1)
         (while (<= 
(setq idx (1+ idx)) (if closed (+ plast 2) (- plast 
2)))
           
(cond
             
((and (or (equal (angle (nth p1 d10) (nth p2 
d10))
                              
(angle (nth p2 d10) (nth p3 d10)) 
1e-6)
                       
(equal (nth p1 d10) (nth p2 d10) 
1e-6)
                       
(equal (nth p2 d10) (nth p3 d10) 
1e-6))
                   
(zerop (nth p2 
d42))
                   
(or (= p1 
plast)
                       
(zerop (nth p1 
d42)))
              
)
              
(setq remove (cons p2 remove)) ; build a pointer 
list
              
(setq p2 (if (= p2 plast) 0 (1+ 
p2))
                    
p3 (if (= p3 plast) 0 (1+ 
p3))
              
)
             
)
             
((and (not (zerop (nth p2 
d42)))
                   
(or closed (/= p1 
plast))
                   
(not (zerop (nth p1 d42))) ; got two 
arcs
                   
(equal
                     
(setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 
d10)))
                     
(BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 
d10))
                     
1e-4)
              
)
              
;;  combine the 
arcs
              
(setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 
d42)))))
                    
newb (tan (/ aa 
4.0))
              
)
              
(if (minusp (nth p1 
d42))
                
(setq newb (- (abs 
newb)))
                
(setq newb (abs 
newb))
              
)
              
(setq remove (cons p2 remove)) ; build a pointer 
list
              
(setq d42 (replace d42 p1 
newb))
              
(setq p2 (if (= p2 plast) 0 (1+ 
p2))
                    
p3 (if (= p3 plast) 0 (1+ 
p3))
              
)
             
)
             
(t
              
(setq p1 
p2
                    
p2 (if (= p2 plast) 0 (1+ 
p2))
                    
p3 (if (= p3 plast) 0 (1+ 
p3))
              
)
             
)
           
)
         
)
         (if 
remove
           
(progn
             
(setq count (length 
d10))
             
;; Rebuild the vertex data with pt, start & end width, 
bulge
             
(setq d10 (RemoveNlst remove 
d10)
                   
d40 (RemoveNlst remove 
d40)
                   
d41 (RemoveNlst remove 
d41)
                   
d42 (RemoveNlst remove 
d42)
             
)
             
(setq result (mapcar '(lambda(w x y z) (list(cons 10 
w)
                                       
x  
y
                                       
(cons 42 z))) d10 d40 d41 
d42)
             
)
             
;;  rebuild the entity data with new vertex 
data
             
(setq hlst 
(vl-remove-if
                          
'(lambda (x) (vl-position (car x) '(40 41 42 10))) 
elst)
             
)
             
(mapcar '(lambda (x) (setq hlst (append hlst x))) 
result)
             
(setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) 
hlst))
             
(if (entmod hlst); return ename and number of vertex 
removed
               
(list ent (strcat msg " Vertex removed " (itoa(- count (length 
d10)))))
               
(list ent " Error, may be on locked 
layer.")
             
)
           
)
           (list 
ent "Nothing to remove - no colenier 
vertex.")
         
)
       
)
       (list ent "Nothing to do - Only 
two vertex.")
     )
   
)
 


 ;;  ========  S T A R T   H E R E  
===========
 (setq doc (vla-get-activedocument 
(vlax-get-acad-object)))
 (cond
   ((or (=(type et) 
'ENAME)
        (and (=(type et) 
'VLA-object)
             
(setq et (vlax-vla-object->ename et))))
     
(vla-startundomark doc)
     (setq result (ps1 
et))
     (vla-endundomark 
doc)
    )
   ((= (type et) 
'PICKSET)
     (vla-startundomark 
doc)
     (setq result (mapcar '(lambda(x) (ps1 
x))
             
(vl-remove-if 'listp (mapcar 'cadr (ssnamex 
ss)))))
     (vla-endundomark 
doc)
   )
   ((listp 
et)
     (vla-startundomark 
doc)
     (setq result (mapcar '(lambda(x) (ps1 x)) 
et))
     (vla-endundomark 
doc)
   )
   ((setq result "PSimple Error 
- Wrong Data Type."))
 )
 result
)
(prompt "\nPline 
Simplify loaded, PSimple to run.")
(princ)

Link to comment
Share on other sites

Hi nod684

 

Got this error:-

 

Command: (LOAD "D:/Office/AutoCAD/lsp/RemoveVertex.lsp") ; error: syntax error

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...