TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jt74 on December 12, 2014, 03:16:57 PM
-
I apologize in advance if my subject is confusing; I'm new to lisp!
I "built" a LSP routine which is 99.9% Lee Mac's Insert Blocks at Intersections script. Basically, the script insert a block at intersections along a polyline and rotate the block to be in line with the polyline at the point of intersection.
The routine functions perfectly, but I need to perform the function at every other intersection, rather than at every intersection.
How can I edit the LSP below (probably the for each line I've marked with ;; < ----- below) to function at every other p?
(defun c:ib ( / a b i j n o s sp )
(while
(progn
(setvar 'errno 0)
(initget "Browse")
(setq s (entsel "\nSelect Block to Insert [Browse]: "))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= "Browse" s)
(if (setq n (getfiled "Select Block" (getvar 'dwgprefix) "dwg" 8))
(if (tblsearch "BLOCK" (cadr (fnsplitl n)))
(null (setq n (cadr (fnsplitl n))))
)
(princ "\n*Cancel*")
)
)
( (= 'ename (type (car s)))
(if (= "INSERT" (cdr (assoc 0 (entget (car s)))))
(if (vlax-property-available-p (setq o (vlax-ename->vla-object (car s))) 'effectivename)
(null (setq n (vla-get-effectivename o)))
(null (setq n (vla-get-name o)))
)
(princ "\nObject is not a block.")
)
)
)
)
)
(setq sp (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
(if (and (= 'str (type n)) (setq s (LM:ssget "\nSelect Intersecting Objects: " nil)))
(repeat (setq i (sslength s))
(setq a (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(if (vlax-method-applicable-p a 'intersectwith)
(repeat (setq j i)
(setq b (vlax-ename->vla-object (ssname s (setq j (1- j)))))
(if (vlax-method-applicable-p b 'intersectwith)
(foreach p (LM:Intersections a b acextendnone) ;;;; <--- foreach to be edit to "for every other"
(setq
;;;;;;;;;;;;;;;;
; esel (entsel "\nSelect Polyline: ")
;pol (car esel); the Polyline's entity name
;pt (osnap (cadr esel) "nea"); use Osnap to ensure it's really ON the Polyline
ang
(angle
'(0 0 0)
(vlax-curve-getFirstDeriv
a
(vlax-curve-getParamAtPoint a p)
); end 1st deriv
); end angle & ang
); end setq
;;;;;;;;;;;;;;;;
(vla-insertblock sp (vlax-3D-point p) n 1.0 1.0 1.0 ang)
)
)
)
)
)
)
(princ)
)
;;--------------------=={ Intersections }==-------------------;;
;; ;;
;; Returns a list of all points of intersection between ;;
;; two objects for the given intersection mode. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; obj1, obj2 - VLA-Objects ;;
;; mode - acextendoption enum of intersectwith method ;;
;;------------------------------------------------------------;;
;; Returns: List of intersection points, or nil ;;
;;------------------------------------------------------------;;
(defun LM:Intersections ( obj1 obj2 mode / l r )
(setq l (vlax-invoke obj1 'intersectwith obj2 mode))
(repeat (/ (length l) 3)
(setq r (cons (list (car l) (cadr l) (caddr l)) r)
l (cdddr l)
)
)
(reverse r)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg - selection prompt
;; params - list of ssget arguments
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com)
(princ)
-
Welcome to the Swamp.
maybe this will do:
skips first one & executes every other one
if you want first to execute use (setq tog 1)
(if (vlax-method-applicable-p b 'intersectwith)
(progn
(setq tog 0)
(if (zerop (setq tog (- 1 tog))) ; note that 1- does not work
(foreach p (lm:intersections a b acextendnone)
(setq
;; esel (entsel "\nSelect Polyline: ")
;;pol (car esel); the Polyline's entity name
;;pt (osnap (cadr esel) "nea"); use Osnap to ensure it's really ON the Polyline
ang (angle '(0 0 0) (vlax-curve-getfirstderiv a (vlax-curve-getparamatpoint a p)) ; end 1st deriv
) ; end angle & ang
) ; end setq
(vla-insertblock sp (vlax-3d-point p) n 1.0 1.0 1.0 ang)
)
)
)
)
-
Hiya CAB, and thanks for the response. I very much appreciate your contributions to the Swamp!
Your zerop toggle set me in the right direction. My minor edit to your contribution was to pull the setq tog 0 up and out of the repeat loop within which the if (vlax-method-applicable-p b 'intersectwith condition resides.
Thanks a million.
Here's the ultimate code which will place a block at every other intersection along a polyline and rotate the block to be inline with the polyline:
;; Code is derived from Lee Mac's "Insert Block at Intersection" LSP code.
;; Edits to Lee Mac's code are noted.
;; Thanks to SWAMP contributor CAB for the guiding light!
;;------------=={ Insert Block at Intersections }==-----------;;
;; ;;
;; Prompts the user to select or specify a block to be ;;
;; inserted, and make a selection of intersecting objects. ;;
;; Proceeds to insert the specified block at all points of ;;
;; intersection between all objects in the selection. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
(defun c:ib ( / a b i j n o s sp )
(while
(progn
(setvar 'errno 0)
(initget "Browse")
(setq s (entsel "\nSelect Block to Insert [Browse]: "))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= "Browse" s)
(if (setq n (getfiled "Select Block" (getvar 'dwgprefix) "dwg" 8))
(if (tblsearch "BLOCK" (cadr (fnsplitl n)))
(null (setq n (cadr (fnsplitl n))))
)
(princ "\n*Cancel*")
)
)
( (= 'ename (type (car s)))
(if (= "INSERT" (cdr (assoc 0 (entget (car s)))))
(if (vlax-property-available-p (setq o (vlax-ename->vla-object (car s))) 'effectivename)
(null (setq n (vla-get-effectivename o)))
(null (setq n (vla-get-name o)))
)
(princ "\nObject is not a block.")
)
)
)
)
)
(setq sp (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
(if (and (= 'str (type n)) (setq s (LM:ssget "\nSelect Intersecting Objects: " nil)))
(repeat (setq i (sslength s))
(setq a (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(setq tog 1) ;; <====TOGGLE TO 0 to stagger block placement. ;; integrated into LM's code for "every other" functionality
(if (vlax-method-applicable-p a 'intersectwith)
(repeat (setq j i)
(setq b (vlax-ename->vla-object (ssname s (setq j (1- j)))))
(if (vlax-method-applicable-p b 'intersectwith)
(progn ;; Thanks to CAB
(if (zerop (setq tog (- 1 tog))) ; note that 1- does not work ;; for the "every other" progn!!
(foreach p (LM:Intersections a b acextendnone)
(setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv a (vlax-curve-getParamAtPoint a p)) ; end 1st deriv
); end angle & ang ;; ang and angle integrated into LM's code
); end setq ;; for block rotation
(vla-insertblock sp (vlax-3D-point p) n 1.0 1.0 1.0 ang)
); end foreach
); end if zerop
); end progn
) ; end if vlax method
)
)
)
)
(princ)
)
;;--------------------=={ Intersections }==-------------------;;
;; ;;
;; Returns a list of all points of intersection between ;;
;; two objects for the given intersection mode. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; obj1, obj2 - VLA-Objects ;;
;; mode - acextendoption enum of intersectwith method ;;
;;------------------------------------------------------------;;
;; Returns: List of intersection points, or nil ;;
;;------------------------------------------------------------;;
(defun LM:Intersections ( obj1 obj2 mode / l r )
(setq l (vlax-invoke obj1 'intersectwith obj2 mode))
(repeat (/ (length l) 3)
(setq r (cons (list (car l) (cadr l) (caddr l)) r)
l (cdddr l)
)
)
(reverse r)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg - selection prompt
;; params - list of ssget arguments
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com)
(princ)
-
You're welcome.
Be aware that the tog var end state will affect the next item in the LOOP in that it may or may not be set to 1.