(vl-load-com)
(while
(setq obj (entsel "\nselect Breakobject! ")
en (car obj)
pt (car (cdr obj))
)
(if
(or
(equal (cdr (assoc 0 (entget en))) "POLYLINE")
(equal (cdr (assoc 0 (entget en))) "LWPOLYLINE")
)
(progn
(setq i (fix (vlax-curve-getParamAtPoint en
(vlax-curve-getClosestPointTo en pt)
)
)
p1 (vlax-curve-getPointAtParam en i)
p2 (vlax-curve-getPointAtParam en (1+ i))
)
(list p1 p2)
)
)
(command "_BREAK" obj "_F" p1 p2)
(princ)
)
Hi!
My problem is, sometimes works break command not rigtht...
The 'cheats' way:Code - Auto/Visual Lisp: [Select]
Hi!change
Iīve done here a simple routines which can erase segments in a polyline. My problem is, sometimes works break command not rigtht. Know anybody a better way to can do program it.
I only want erase a picked segment in a polyline but not explode line because I need them som Polyline.
...(command "_BREAK" obj "_F" p1 p2)...
into...(command "_BREAK" en p1 p2)...
or...(command "_BREAK" p1 p2)...
(defun c:test ( /
)
(setvar "OSMODE" 0)
(if
(= (cdr
(assoc 0
(entget
(setq en (car
(setq pt (entsel "\nSelect Polyline "))
)
)
)
)
)
"POLYLINE")
(progn
(setq segN (abs (fix (vlax-curve-getendparam en)))) ; number of segments
(setq vl-en (vlax-ename->vla-object en))
(setq pt (vlax-curve-getClosestPointTo vl-en (cadr pt)))
(setq segP (vlax-curve-getparamAtPoint vl-en pt))
(setq segA (vlax-curve-getpointatparam vl-en (fix segP)))
(setq segE (vlax-curve-getpointatparam vl-en (1+ (fix segP))))
)
)
)
Lee your routines for delete segments in LwPolylines is very good.
I'm wondering how could I do this with 3dPolylines.
(defun c:test ( /
en
vl-en
pt
segN
segP
segA
segE
)
(setvar "OSMODE" 0)
(setq en (car (setq pt (entsel "\nSelect Polyline "))))
(if (wcmatch (strcase (cdr (assoc 0 (entget en)))) "*POLYLINE")
(progn
(setq segN (abs (fix (vlax-curve-getendparam en)))) ; number of segments
(setq vl-en (vlax-ename->vla-object en))
(setq pt (vlax-curve-getClosestPointTo vl-en (cadr pt)))
(setq segP (vlax-curve-getparamAtPoint vl-en pt))
(setq segA (vlax-curve-getpointatparam vl-en (fix segP)))
(setq segE (vlax-curve-getpointatparam vl-en (1+ (fix segP))))
(command "_break" en segA segE)
)
(princ "\nObject was not a Polyline")
)
(princ)
)
(setq p
(fix
(vlax-curve-getparamatpoint (car l)
(vlax-curve-getclosestpointto (car l) (trans (cadr l) 1 0))
)
)
)
Is it a bug i vl-function that I donīt get right segment
It goes... thank you so much Lee, you have done it perfect.
It was maybe precision that vlax-curve-getClosestPointToProjection is in this case better.
Great thanks for your time and explantion - itīs clear now "why"
Completly another trick to erase segments in a Polyline is to press CTRL and than click on the segment
Is it a bug i vl-function that I donīt get right segment
Its not a bug with the vlax-curve-* functions, try the following instead:Code - Auto/Visual Lisp: [Select]
Thanks a million this works perfectly for all types of polylines.
(if (setq insertpt1 (getpoint "\nPick Insertion Point: "))
(progn
(if (and (setq ntsel (nentselp insertpt1))
(= (length ntsel) 2)
(setq name (car ntsel))
(wcmatch (cdr (assoc 0 (entget name)))"LINE,LWPOLYLINE")
);; and
(if (eq (vla-get-ObjectName obj) "AcDbPolyline")
(setq p3 insertpt1
p2 (angle insertpt1 (vlax-curve-getpointatparam obj (fix (vlax-curve-getparamatpoint obj insertpt1)))))
(setq p3 insertpt1
p2 (angle (vlax-curve-getStartpoint obj) (vlax-curve-getEndPoint obj)))
)
(command "break" name (polar p3 p2 a2) (polar p3 p2 a3))
(defun c:DELSEGS ( / *error* en flag p)
(vl-load-com)
(defun *error* (msg)
(if oldCMDECHO (setvar "CMDECHO" oldCMDECHO))
(princ msg)
(princ)
) ;defun *error*
(setq en T flag 0 oldCMDECHO (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while en
(initget "u")
(setq en (entsel "\nSelect segment <complete>: "))
(cond
( (= en "u")
(if (> flag 0)
(progn
(vl-cmdf "_u")
(princ "1 segment were recovered")
(setq flag (1- flag) en T)
)
(princ "All removed segments was recovered.")
)
)
( (and (null en) (= (getvar "ERRNO") 7))
(setq en T)
)
( (null en)
(princ (strcat "\nFunction is completed. "
(if (> flag 0) (strcat "Segments removed: " (vl-princ-to-string flag)) "")
)
)
)
( (not (wcmatch (cdr (assoc 0 (entget (car en)))) "*POLYLINE"))
(princ "\nIt's not a polyline.")
(setq en T)
)
( t
(setq p
(fix
(vlax-curve-getParamAtPoint (car en)
(vlax-curve-getClosestPointToProjection
(car en)
(trans (cadr en) 1 0)
'(0.0 0.0 1.0)
)
)
)
)
(command "_.break" en "_F"
"_non" (trans (vlax-curve-getPointAtParam (car en) p ) 0 1)
"_non" (trans (vlax-curve-getPointAtParam (car en) (1+ p)) 0 1)
)
(setq flag (1+ flag))
)
)
)
(setvar "CMDECHO" oldCMDECHO)
(princ)
)