Topic: a new poly from a old poly

[DEVITG]

I have a lwpoly , no bulges on it
It have 8 param from 0 to 7

How can I get a new poly from param 2.5 to param 5.3

Like to make trim at both param , and keep the middle part

Thanks in advance

[gile]

Hi,

you can use the vlax-curve-getPointAtParam function.

a quick and dirty example :

Code: [Select]

(defun c:test (/ ent start-parm end-param start-point end-point plst)
  (if
    (and
      (setq ent (car (entsel)))
      (setq ent (vlax-ename->vla-object ent))
      (or (initget 5)
  (setq start-param (getreal "\nNew start parameter: "))
      )
      (or (initget 5)
  (setq end-param (getreal "\nNew end parameter: "))
      )
      (< start-param end-param)
      (setq start-point (vlax-curve-getPointatParam ent start-param))
      (setq end-point (vlax-curve-getPointatParam ent end-param))
      (setq plst (2d-coord->pt-lst (vlax-get ent 'Coordinates)))
    )
     (progn
       (repeat (fix (- (vlax-curve-getendParam ent) (fix end-param)))
(setq plst (reverse (cdr (reverse plst))))
(vlax-put ent 'Coordinates (apply 'append plst))
       )
       (vlax-put ent
'Coordinates
(apply 'append
(setq plst
       (append plst
       (list
((lambda (p)
    (list (car p) (cadr p))
  )
   (trans end-point 0 (vlax-get ent 'Normal))
)
       )
       )
)
)
       )
       (repeat (1+ (fix start-param))
(setq plst (cdr plst))
(vlax-put ent 'Coordinates (apply 'append plst))
T
       )
       (vlax-put ent
'Coordinates
(apply 'append
(cons ((lambda (p)
(list (car p) (cadr p))
       )
(trans start-point 0 (vlax-get ent 'Normal))
      )
      plst
)
)
       )
     )
  )
  (princ)
)

[VovKa]

help is rather contradictory about Coordinates property

You cannot change the number of coordinates in the object by using this property. You can change only the location of existing coordinates.

When setting the coordinates for a polyline, if you supply fewer coordinates than the object currently possesses, the polyline will be truncated. Any fit points applying to the truncated vertices will also be truncated. If you supply more coordinates than the object currently possesses, the extra vertices will be appended to the polyline.

most likely we'll get

 ; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

[T.Willey]

Vovka,

  If I remember correctly you can only remove one vertex at a time using the Coordinate property.  If you try more than one you will get an error.

[DEVITG]

I solve it as follow ,

(setq obj cate-poly)
  (setq st-par param-izq)
  (setq en-par param-der)

 
(setq min-par (min st-par en-par))
(setq max-par (max st-par en-par))

(setq per-ent-min (fix (1+ min-par )))
  (setq per-ent-max (fix  max-par ))

(setq par-qty ( - per-ent-max per-ent-min))

(setq new-par-lst nil)

(setq new-par-lst (cons min-par new-par-lst))   

(repeat (1+ par-qty)
  (setq new-par-lst (cons per-ent-min new-par-lst))
(setq per-ent-min (1+ per-ent-min))
  )
(setq new-par-lst (cons max-par new-par-lst))
(setq new-pt-list nil)
(foreach par new-par-lst
  (setq pt(butlast (vlax-curve-getPointatparam obj par)))
(setq new-pt-list (cons pt new-pt-list))
  )

Now I can bulid-up the new poly

[gile]

When editing vertex more than one by one with the coordinates property you can have an error with acad versions prior than 2007 (see here).

I edited the code so that vertex are removed or add one by one, if it still doesn't work, perhaps add a (vla-update ent) after each (vla-put ent 'Coordinates ...) expression.

[VovKa]

i modified the first version of gile's code
it still doesn't work for me, but anyway...

Code: [Select]

(vl-load-com)
(defun test (EntName From To / Counter End Start)
  (setq       EntName (vlax-ename->vla-object EntName)
Start (reverse (cdr (reverse (vlax-curve-getPointAtParam EntName From))))
End (reverse (cdr (reverse (vlax-curve-getPointAtParam EntName To))))
From (* (1+ (fix From)) 2)
To (1- (* (1+ (fix To)) 2))
Counter -1
  )
  (vlax-put EntName
    'Coordinates
    (append Start
    (vl-remove-if-not
      (function (lambda (c) (<= From (setq Counter (1+ Counter)) To)))
      (vlax-safearray->list
(vlax-variant-value (vla-get-Coordinates EntName))
      )
    )
    End
    )
  )
)
;;;(test (car (entsel)) 2.5 5.3)


[gile]

Vovka,

It works fine on acad 2007.

[CAB]

Here is my shot at it. Although it doesn't  work in 2000.

Code: [Select]

(vl-load-com)
(defun test (EntName FromP ToP / EntName plist parm pt)
  (setq EntName (vlax-ename->vla-object EntName))
  (setq plist (cdr (reverse (vlax-curve-getpointatparam EntName FromP)))
        parm  (1+ (fix FromP))
  )
  (while (and (< parm ToP)
              (setq pt (vlax-curve-getpointatparam EntName parm)))
    (setq plist (append (cdr (reverse pt)) plist)
          parm  (1+ parm))
  )
  (setq plist
         (reverse (append (cdr (reverse (vlax-curve-getpointatparam EntName ToP)))
                          plist))
  )
  (vlax-put EntName 'Coordinates plist)
)
;;;(test (car (entsel)) 2.5 5.3)

[VovKa]

this one will work (i hope) for Autocad <2007

Code: [Select]

(defun test (EntName From To / Counter End Start)
  (setq Start (reverse (cdr (reverse (vlax-curve-getPointAtParam EntName From))))
End (reverse (cdr (reverse (vlax-curve-getPointAtParam EntName To))))
From (fix From)
To (1+ (fix To))
Counter -1
  )
  (entmod
    (vl-remove nil
       (mapcar (function (lambda (c)
   (cond ((= (car c) 90) (cons 90 (- To From -1)))
((= (car c) 70)
  (if (= (logand (cdr c) 1) 1)
    (cons 70 (1- (cdr c)))
    (cdr c)
  )
)
((= (car c) 10)
  (setq Counter (1+ Counter))
  (cond ((= Counter From) (cons 10 Start))
((= Counter To) (cons 10 End))
((< From Counter To) c)
  )
)
((vl-position (car c) '(40 41 42))
  (if (<= From Counter To)
    c
  )
)
(t c)
   )
)
       )
       (entget EntName)
       )
    )
  )
)
;;;(test (car (entsel)) 2.5 5.3)