multiple slice

[dineh]

Hi guys, Does any know or have a lisp that how to slice multiple 3d solids with a specified distance among them like "MLINE"  Thanks in advance

[marko_ribar]

(defun c:mslice ( / *error* cmd s p d n i el pp )

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (if command-s
      (command-s "_.UNDO" "_E")
      (vl-cmdf "_.UNDO" "_E")
    )
  )
  (if command-s
    (command-s "_.UNDO" "_M")
    (vl-cmdf "_.UNDO" "_M")
  )
  (prompt "\nSelect 3DSOLID(s) to multiple slice by XY parallel planes...")
  (if (setq s (ssget "_:L" '((0 . "3DSOLID"))))
    (progn
      (initget 1)
      (setq p (getpoint "\nPick or specify reference point on plane parallel with XY axises of current UCS : "))
      (initget 7)
      (setq d (getdist "\nPick or specify distance between slicing planes : "))
      (initget 7)
      (setq n (getint "\nSpecify number of slicing actions : "))
      (setq i -1 el (entlast))
      (while (and el (< (setq i (1+ i)) n))
        (setq pp (mapcar (function +) p (list 0.0 0.0 (* i d))))
        (if command-s
          (command-s "_.SLICE" s "" "_XY" "_non" pp "_B")
          (vl-cmdf "_.SLICE" s "" "_XY" "_non" pp "_B")
        )
        (if (and (/= i 0) (eq el (setq el (entlast))))
          (setq el nil)
        )
      )
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
    (prompt "\nNothing selected...")
  )
  (*error* nil)
)

 

(defun c:mslicexy+rot-alongz-WCS3dsol-dist ( / *error* cmd sol ll ur d h n k r bp e gr loop )

  (vl-load-com)

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (if command-s
      (command-s "_.UNDO" "_E")
      (vl-cmdf "_.UNDO" "_E")
    )
  )
  (if command-s
    (command-s "_.UNDO" "_M")
    (vl-cmdf "_.UNDO" "_M")
  )
  (while
    (or
      (not (setq sol (car (entsel "\nPick 3DSOLID placed in WCS..."))))
      (if sol
        (or
          (/= (cdr (assoc 0 (entget sol))) "3DSOLID")
          (vla-getboundingbox (vlax-ename->vla-object sol) (quote ll) (quote ur))
          (not (equal 0.0 (caddr (safearray-value ll)) 1e-6))
        )
      )
    )
    (setq ll nil ur nil)
    (prompt "\nMissed or picked wrong entity type, or picked 3DSOLID not lie in WCS...")
  )
  (setq h (caddr (safearray-value ur)))
  (setq d 1e+308)
  (while (or (> d h) loop)
    (prompt "\nHeight and max. distance is : ") (princ (rtos h 2 50))
    (initget 7)
    (setq d (getdist "\nPick or specify distance between slice XY planes along Z axis : "))
    (setq n (fix (/ h d)))
    (prompt "\nThere will be : ") (princ n) (prompt " sliced 3DSOLIDS.")
    (prompt "\nENTER - CONTINUE; SPACE - CHOOSE")
    (while
      (and
        (setq gr (grread nil))
        (not
          (and
            (= (car gr) 2)
            (= (cadr gr) 13)
          )
        )
        (not
          (and
            (= (car gr) 2)
            (= (cadr gr) 32)
          )
        )
      )
    )
    (if (= (cadr gr) 32)
      (setq loop t)
      (setq loop nil)
    )
  )
  (initget 1)
  (setq r (getreal "\nSpecify unit angle in decimal degrees - can be positive CCW or negative CW or even 0.0 : "))
  (initget 1)
  (setq bp (getpoint "\nPick or specify base point for incremental rotations : "))
  (setq k 0)
  (repeat n
    (if command-s
      (command-s "_.SLICE" sol "" "_XY" "_non" (list 0.0 0.0 (* (setq k (1+ k)) d)) "_B")
      (vl-cmdf "_.SLICE" sol "" "_XY" "_non" (list 0.0 0.0 (* (setq k (1+ k)) d)) "_B")
    )
    (vla-getboundingbox (vlax-ename->vla-object (entlast)) (quote ll) (quote ur))
    (if (equal (caddr (safearray-value ur)) (* k d) 1e-6)
      (setq e sol)
      (setq e (setq sol (entlast)))
    )
    (if command-s
      (command-s "_.ROTATE" e "" "_non" bp r)
      (vl-cmdf "_.ROTATE" e "" "_non" bp r)
    )
  )
  (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
  (*error* nil)
)

 

Regards, M.R.

HTH.

Edited October 7, 2022 by marko_ribar