I have this lisp for filter POLYLINE, LINE, ARC, LWPOLYLINE, SPLINE, ELLIPSE, 3DPOLYLINE, MULTILINE, RAY, CIRCLE:
;;SS - the objects are filtered by object type, layer, color and linetype.
(defun C:SS ( / s1 i e l f s2)
(princ "\nSelect source object:")
(if
(if
(setq s1 (ssget "I"))
(progn (sssetfirst nil nil) s1)
(setq s1 (ssget))
)
(progn
(repeat (setq i (sslength s1))
(setq i (1- i)
e (entget (ssname s1 i))
l (mapcar '(lambda (a b) (cond ((assoc a e)) (b))) '(0 8 6 62) '(0 0 (6 . "ByLayer") (62 . 256)))
)
(if (not (member l f)) (setq f (cons l f)))
)
(setq f (mapcar '(lambda (a) (append '((-4 . "<AND")) a '((-4 . "AND>")))) f))
(setq f (append '((-4 . "<OR")) (apply 'append f) '((-4 . "OR>"))))
(princ "\n\nSelect area for similar objects...")
(if (setq s2 (ssget f)) (princ (strcat (itoa (sslength s2)) " objects")))
(sssetfirst nil s2)
)
)
(if (zerop (getvar 'cmdactive)) (princ) s2)
)
... and I have this lisp to insert block in the vertex start point and end point:
; Copy To Vertices
(defun c:CTVR (/ foo ss lst pt pntC pntP 1stD closed aim aimchk)
;;; KC changed command name [+ R for Rotation]; added 3 localizedvariables
;;;;; ;; Copy object(s) to vertices of select curves (Arc, Line, *Polyline, Spline)
;;;;; limit to Polylines for now:
;; Copy object(s) to vertices of select Polylines
;; Alan J. Thompson, 09.24.10
;; http://www.theswamp.org/index.php?topic=35033.msg402543#msg402543
;|
Modified by Kent Cooper to align with halfway-between direction of Polyline
segments either side of vertex, AutoCAD Customization Forum 19 April 2018
|;
(defun foo (p)
(if (vl-consp p)
(or (vl-member-if
(function (lambda (a) (equal (list (car a) (cadr a)) (list (car p) (cadr p)))))
plst
)
( (lambda (pnt)
(foreach x lst
(vla-move (vla-copy x) pt pnt)
;;; KC added for rotation:
(setq
pntC (vlax-safearray->list (vlax-variant-value pnt))
;; [point as Coordinates list rather than VLA variant]
pntP (vlax-curve-getParamAtPoint e pntC); Parameter value there
1stD (vlax-curve-getFirstDeriv e pntP)
closed (vlax-curve-isClosed e)
); setq
(command "_.rotate" "_last" "" pntC
(strcat
(rtos
(cond
;;; ( (wcmatch (cdr (assoc 0 (entget e))) "LINE,ARC,SPLINE");;;;; getting VVC: Internal Error for these
;;; (aim 1stD)
;;; ); only-ends-object condition
;; remaining conditions apply to Polylines [LW or heavy]
( (and
(or
(equal pntC (vlax-curve-getStartPoint e) 1e-4)
(equal pntC (vlax-curve-getEndPoint e) 1e-4)
); or
(not closed)
); and
(aim 1stD)
); start-or-end-of-open condition
( (and
(equal pntC (vlax-curve-getStartPoint e) 1e-4)
closed
); and
(aimchk
(aim 1stD)
(aim (vlax-curve-getFirstDeriv e (- (vlax-curve-getEndParam e) 0.05)))
); aimchk
); start-of-closed condition
( (and
(equal pntC (vlax-curve-getEndPoint e) 1e-4)
closed
); and
(aimchk
(aim (vlax-curve-getFirstDeriv e 0))
(aim (vlax-curve-getFirstDeriv e (- (vlax-curve-getEndParam e) 0.05)))
); aimchk
); end-of-closed condition
( (aimchk
(aim 1stD)
(aim (vlax-curve-getFirstDeriv e (- pntP 0.05)))
); aimchk
); intermediate-vertex condition
); cond
2 8
); rtos
"r" ; which is in radians
); strcat
); command
;;; end of added code for rotation
); foreach
(setq pLst (cons p pLst))
); lambda
(vlax-3d-point p)
)
)
)
)
;;; KC added functions for use in added rotation code:
(defun aim (deriv) (angle '(0 0 0) deriv))
(defun aimchk (aim1 aim2); check for certain directional relationship
(if (< (abs (- aim1 aim2)) pi)
(/ (+ aim1 aim2) 2); then - split the difference
(+ (/ (+ aim1 aim2) 2) pi); else - split & turn around
); if
); defun -- aimchk
;;; end of added functions for use in rotation
(if (and (princ "\nSelect object(s) to copy: ")
(setq lst ((lambda (i / ss e l)
(if (setq ss (ssget "_:L"))
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
)
-1
)
)
(setq pt ((lambda (p) (cond (p (vlax-3d-point (trans p 1 0)))))
(getpoint "\nSpecify base point: ")
)
)
(princ "\nSelect curves to copy object(s) along: ")
;;;;; (setq ss (ssget '((0 . "ARC,LINE,*POLYLINE,SPLINE"))));;;;; limit to Polylines for now
(setq ss (ssget '((0 . "*POLYLINE"))));;;;; limit to Polylines for now
)
((lambda (i / e eLst p pLst)
(while (setq e (ssname ss (setq i (1+ i))))
(cond
((vl-position (cdr (assoc 0 (setq eLst (entget e)))) '("ARC" "LINE" "SPLINE"))
(mapcar (function foo) (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e)))
)
((vl-position (cdr (assoc 0 eLst)) '("LWPOLYLINE" "POLYLINE"))
(repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
(foo (vlax-curve-getPointAtParam e (setq p (1- p))))
)
)
)
)
)
-1
)
)
(princ)
)
...I need to merge the use of both, to filter *lines and to insert blocks in the selected vertex. But I just have a problem, I just want to insert the blocks in the selected vertex with cpolyline, just like stretch works with endpoints when select one endpoint.
someone can help me?
