Topic: How is "LWPOLYLINE" assigns the new beginning grid reference ?

[hunterxyz]

How is "LWPOLYLINE" assigns the new beginning grid reference
Thanks

[hunterxyz]

Under I will use the change of program,
but actually not will send attempts the Yuan to extend the material shift,
whether will have other better method?

Code: [Select]

(SETQ ENT (CAR (ENTSEL "\n Select LWPOLYLINE :")))
(SETQ PT (GETPOINT "\n Set Start Point :"))
(JTHWAX-SET-PLINE-STARTPOINT ENT PT)

(DEFUN JTHWAX-SET-PLINE-STARTPOINT
(ENT PT / A ACENT ACPL B BLST EWID I LAYR N NUMP PLCL PTLT
 RETURNS-OBJ SWID TY VLST)
(SETQ PT (LIST (NTH 0 PT) (NTH 1 PT)))
(SETQ vlst (VL-REMOVE-IF 'NULL
     (MAPCAR '(LAMBDA (a) (IF (= (CAR a) 10)
    (CDR a)
   ))
     (ENTGET ENT))))
 
(SETQ blst (VL-REMOVE-IF 'NULL
   (MAPCAR '(LAMBDA (a) (IF (= (CAR a) 42)
(CDR a)
))
   (ENTGET ENT))))
 
(SETQ I -1)
(SETQ N NIL)

(FOREACH XPTX vlst
(SETQ I (1+ I))
 (PRINT I)
 (PRINT XPTX)
 (PRINT PT)
(IF (EQUAL PT XPTX 1e-009)
 (SETQ N I)
 )
)
 
(IF N
(PROGN

(REPEAT N
 (SETQ vlst (APPEND (CDR vlst) (LIST(CAR vlst))))
 (SETQ blst (APPEND (CDR blst) (LIST(CAR blst))))
)

(SETQ ptlt  (APPLY 'APPEND
    (MAPCAR '(LAMBDA (a b) (LIST (CONS 10 a) (CONS 42 b)))
    vlst blst )))

(SETQ nump  (CONS 90 (LENGTH vlst)))
(SETQ swid  (ASSOC 40 (ENTGET ent)))
(SETQ ewid  (ASSOC 41 (ENTGET ent)))
(SETQ layr  (ASSOC 8 (ENTGET ent)))
(SETQ ty    (CADR (ENTGET ent)))
(SETQ acent (NTH 4 (ENTGET ent)))
(SETQ acpl  (NTH 8 (ENTGET ent)))
(SETQ plcl  (ASSOC 70 (ENTGET ent)))

(ENTMAKE(APPLY 'APPEND (LIST (LIST ty)
     (LIST acent)
     (LIST layr )
     (LIST (CONS 67 0))
     (LIST acpl)
     (LIST nump)
     ptlt
     (LIST swid)
     (LIST ewid)
     (LIST plcl)
)))

(ENTDEL ent)
)
)
)



[CAB]

Not sure what your are trying to do.

Do you want to trim the pline by selecting a new start point?

If so, you will need some way to determine which part of the pline to keep.
Perhaps the part where the selection was made.


Could you clarify your request?

[hunterxyz]

Do you want to trim the pline by selecting a new start point?
yes.

I need to understand how should Shift the "LWPOLYLINE" Extended Data.
example: dictionary or Extended Data

[Kerry]

Do you want to trim the pline by selecting a new start point?
yes.

Have a play with something like this

Code: [Select]

(SETQ oEnt           (VLAX-ENAME->VLA-OBJECT (CAR (ENTSEL "\n Select LWPOLYLINE :")))
      PT             (GETPOINT (vlax-curve-getStartPoint oEnt) "\n Set NEW Start Point :")
      lstCoordinates (VLAX-SAFEARRAY->LIST
                       (VLAX-VARIANT-VALUE (VLA-GET-COORDINATES oEnt))
                     )
)
(VLAX-PUT oEnt
          'Coordinates
          (APPEND (LIST (CAR PT) (CADR PT)) (CDDR lstCoordinates))
)

[Kerry]

A piccy ...

[hunterxyz]

Kerry Brown ,THANK!

But,
I do not want delete the any vertex,
only wants to change new starts vertex.

[Kerry]

That IS what it's doing,

[gile]

Hi,

Here's one i wrote some time ago. it allows to choose a new start point anywhere on the pline. If the specified point is not an existing vertex, a new one is added.

Code: [Select]

;;; PlineOrg (2.0) -Gilles Chanteau- 15/09/2007
;;; To change the start point of a closed polyline

(defun c:plineorg (/ erreur os pt pl plst norm nb n blst pa d1 d2 d3)

  (vl-load-com)

  (defun erreur (msg)
    (if (= msg "Function cancelled")
      (princ)
      (princ (strcat "\nError: " msg))
    )
    (setvar "OSMODE" os)
    (setq *error* m:err
  m:err nil
    )
  )

  (setq m:err *error*
*error* erreur
os (getvar "OSMODE")
  )
  (setvar "OSMODE" 515)
  (if (and
(setq pt
       (getpoint
"\nSelect a new start point on the polyline: "
       )
)
(setq pl (car (nentselp pt)))
(setq pl (vlax-ename->vla-object pl))
(= (vla-get-ObjectName pl) "AcDbPolyline")
(= (vla-get-Closed pl) :vlax-true)
      )
    (progn
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq plst (vlax-get pl 'Coordinates)
    norm (vlax-get pl 'Normal)
    pt   (trans pt 1 0)
    pa (vlax-curve-getParamAtPoint pl pt)
    nb (/ (length plst) 2)
    n nb
      )
      (repeat n
(setq blst (cons (vla-getBulge pl (setq n (1- n))) blst))
      )
      (if (= pa (fix pa))
(setq n    (fix pa)
      plst (append (sublist plst (* 2 n) nil)
   (sublist plst 0 (* 2 n))
   )
      blst (append (sublist blst n nil) (sublist blst 0 n))
)
(setq n    (1+ (fix pa))
      d3 (vlax-curve-getDistAtParam pl n)
      d2 (- d3 (vlax-curve-getDistAtPoint pl pt))
      d3 (- d3 (vlax-curve-getDistAtParam pl (1- n)))
      d1 (- d3 d2)
      pt   (trans pt 0 (vlax-get pl 'Normal))
      plst (append (list (car pt) (cadr pt))
   (sublist plst (* 2 n) nil)
   (sublist plst 0 (* 2 n))
   )
      blst (append (list (k*bulge (nth (1- n) blst) (/ d2 d3)))
   (sublist blst n nil)
   (sublist blst 0 (1- n))
   (list (k*bulge (nth (1- n) blst) (/ d1 d3)))
   )
)
      )
      (vlax-put pl 'coordinates plst)
      (repeat (setq n (length blst))
(vla-setBulge pl (setq n (1- n)) (nth n blst))
      )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (prompt "\nUnvalid entity.")
  )
  (princ)
)

;;; SUBLIST Return a sub-list
;;;
;;; Arguments
;;; lst : a list
;;; start : start index for the sub-list (first item = 0)
;;; leng : sub-list length (or nil)
;;;
;;; Examples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
  (if (or (not leng) (< (- (length lst) start) leng))
    (setq leng (- (length lst) start))
  )
  (setq n (+ start leng))
  (repeat leng
      (setq r (cons (nth (setq n (1- n)) lst) r))
    )
)

;; K*BULGE
;; Returns a bulge which is proportional to a reference
;; Arguments :
;; b : the reference bulge
;; k : the ratio (between angles or arcs length)

(defun k*bulge (b k / a)
  (setq a (atan b))
  (/ (sin (* k a)) (cos (* k a)))
)

[hunterxyz]

Is result which I wants

Thank ~ gile