[编程交流] 在多段线上创建顶点

(vl-load-com)
(setq s1 (car (entsel)))
(setq pl (vlax-ename->vla-object s1))
(defun vlax-list->2D-point  (lst)
 (if lst
   (cons (list (car lst) (cadr lst))
         (vlax-list->2D-point (cddr lst)))))
(setq vertCoord(vlax-list->2D-point (vlax-get pl 'Coordinates)))
(setq vertStart (car vertCoord))

(if (setq polyline (car (entsel)))
 (or
   (= 1 (logand 1 (cdr (assoc 70 (entget polyline)))))
   (vlax-curve-isClosed polyline)
   (eq :vlax-true (vla-get-Closed (vlax-ename->vla-object polyline)))
 )
)

; pline co-ords example
; By Alan H
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq len (length co-ords))
(setq numb (/ len 2)) ; even and odd check required
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(co-ords2xy) ; list of 2d points making pline

;;----------------=={ Add LWPolyline Vertex }==---------------;;
;;                                                            ;;
;;  Adds a new vertex to an LWPolyline at a point specified   ;;
;;  by the user; compatible with LWPolylines at any           ;;
;;  orientation, with varying width and arc segments.         ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    17-12-2012                            ;;
;;                                                            ;;
;;  First release.                                            ;;
;;------------------------------------------------------------;;
(defun c:apv ( / a b e h l n p r w x z )
   (while ;;inf loop
       (progn (setq p (getpoint "\nPick Point for New Vertex: "))
           (cond
               (   (null p) nil) ;; 1st cond - if p not equal 0 return nil
               (   (null (setq e (nentselp p))) ;; 2nd cond ? The nentselp function returns a 4×4 transformation matrix. What for?
                   (princ "\nPoint does not lie on an LWPolyline.") ;; so if the returned matrix is empty (nil), print this
               )
               (   (= 4 (length e)) ;; 3rd cond - ??
                   (princ "\nObject is Nested.") ;; what is nested object?
               )
               (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget (setq e (car e)))))) ;; 4th cond - compare. If not equal...        
                   (princ "\nObject is not an LWPolyline.") ;; ...print this
               )
           )
       )
   )
   (if (and p e ;; expression returns T if both p and e are not nil, else nil
           (setq p (vlax-curve-getclosestpointto e (trans p 1 0)) ;; the UCS is rotated 90 degrees counterclockwise around the WCS Z axis?? Closest point between e and rotated list
                 n (vlax-curve-getparamatpoint e p) ;; still don't understand what getparamatpoint means
           )
       )
       (if (not (equal n (fix n) 1e-) ;; checks if not equal - n and its truncated value with fuzz distance of 1e-8
           (progn
               (setq e (entget e)
                     h (reverse (member (assoc 39 e) (reverse e))) ;; returns list consisting of 14 lists - what for?
                     l (LM:LWVertices e)
                     z (assoc 210 e)
               ) 
               (repeat (fix n)
                   (setq a (cons (car l) a)
                         l (cdr l)
                   )
               )
               (setq x (car l)
                     r (- n (fix n))
                     w (cdr (assoc 40 x))
                     w (+ w (* r (- (cdr (assoc 41 x)) w)))
                     b (atan (cdr (assoc 42 x)))
               )
               (entmod
                   (append h
                       (apply 'append (reverse a))
                       (list
                           (assoc 10 x)
                           (assoc 40 x)
                           (cons  41 w)
                           (cons  42 (tan (* r b)))
                       )
                       (list
                           (cons  10 (trans p 0 (cdr z)))
                           (cons  40 w)
                           (assoc 41 x)
                           (cons  42 (tan (* (- 1.0 r) b)))
                       )
                       (apply 'append (cdr l))
                       (list z)
                   )
               )
           )
       )
   )
   (princ)
)
;; Tangent  -  Lee Mac
;; Args: x - real
(defun tan ( x )
   (if (not (equal 0.0 (cos x) 1e-10))
       (/ (sin x) (cos x))
   )
)
;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
   (if (setq e (member (assoc 10 e) e))
       (cons
           (list
               (assoc 10 e)
               (assoc 40 e)
               (assoc 41 e)
               (assoc 42 e)
           )
           (LM:LWVertices (cdr e))
       )
   )
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;;                        End of File                         ;;
;;------------------------------------------------------------;;