Hi, I have a problem with this code, it divides only the first unit of each segment and not all segments with distance equal or less than the assigned value.
The code should subdivide each segment of the 3dpoly with a value such that each subdivision is less than or at most equal to the assigned value. So for each segment of the 3dpoly there is a different value with which to subdivide that specific segment.
Can anyone help me ?
(defun c:poly_add_vertex (/ *error* c_doc sv_lst sv_vals
mdst ss cnt vlst ent elst
obj flg sp ep lcnt dst
tdst p
)
(defun *error* (msg)
(mapcar 'setvar sv_lst sv_vals)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(princ (strcat "\nAn Error : " msg " occurred."))
)
(princ)
) ;_end_*error*_defun
(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
sv_lst (list 'cmdecho 'osmode)
sv_vals (mapcar 'getvar sv_lst)
) ;end_setq
(mapcar 'setvar sv_lst '(0 0))
(initget 7)
(setq
mdst (getreal "\nEnter Max Distance between Polyline Vertices : "
)
)
(setq ss (ssget ":L" '((0 . "*POLYLINE"))))
(cond
(ss
(repeat (setq cnt (sslength ss))
(setq elst (entget (setq ent (ssname ss (setq cnt (1- cnt))))))
(cond ((or (= 2 (logand 2 (cdr (assoc 70 elst))))
(= 4 (logand 4 (cdr (assoc 70 elst))))
)
)
(t
(setq vlst nil
obj (vlax-ename->vla-object ent)
flg (if (= (vlax-get obj 'objectname) "AcDbPolyline")
T
nil
)
sp 0
ep (vlax-curve-getendparam ent)
vlst (cons (if flg
(reverse
(cdr (reverse (vlax-curve-getstartpoint ent)))
)
(vlax-curve-getstartpoint ent)
)
vlst
)
lcnt 0.0
) ;end_setq
(while (< sp ep)
(setq dst (distance (vlax-curve-getpointatparam ent sp)
(vlax-curve-getpointatparam ent (1+ sp))
)
tdst dst
)
(cond ((> dst mdst)
(while (> tdst mdst)
(setq vlst (cons
(if flg
(reverse
(cdr (reverse
(vlax-curve-getpointatdist
ent
(setq lcnt (+ lcnt (/ mdst dst)))
)
)
)
)
(vlax-curve-getpointatdist
ent
(setq lcnt (+ lcnt (/ mdst dst)))
)
)
vlst
)
tdst (- tdst mdst)
) ;end_setq
) ;end_while
)
) ;end_cond
(setq sp (1+ sp)
vlst (cons
(if flg
(reverse
(cdr
(reverse (vlax-curve-getpointatparam ent sp))
)
)
(vlax-curve-getpointatparam ent sp)
)
vlst
)
lcnt (vlax-curve-getdistatparam ent sp)
) ;end_setq
) ;end_while
(cond (flg
(setq sp 0)
(while (< sp ep)
(vlax-invoke obj 'setbulge sp 0.0)
(setq sp (1+ sp))
)
)
)
(vlax-put obj 'coordinates (apply 'append (reverse vlst)))
)
) ;end_cond
) ;end_repeat
)
(t (alert "Nothing Selected"))
) ;end_cond
(mapcar 'setvar sv_lst sv_vals)
(princ)
) ;end_defun
;"AcDb2dPolyline" if curved
