Divide lisp

[robwell]

I have another request for a lisp.

 

I have many lines that I need to divide (including arcs) into equal lengths. However, I am looking for a faster (lisp routine would be awesome) way to complete the task with specific parameters.

 

After creating the total line length needed and then the divide to equal lengths is completed, I have to cut the line segment from that divide point back by either 1/4" or 3/8" to each side, creating a 1/2" or 3/4" gap and then shorten each end of the overall line by the same cut length (1/4 or 3/8). That would then give me equal line segments with the gap between. I could do the math separate and create an equidistant line and then place them end to end with the gap, but that is time consuming as well and doesn't really work with an arc line.

 

Is this possible with a lisp? See images for reference. The x is the divide points and there is a gap created with the dims shown after what I have to end up with.

 

Thank you to all the lisp gurus. You guys are awesome.

RW

 

 

[dan113]

Maybe look at creating the lines from scratch instead of modifying what you have on-screen. Use the getxxx functions to prompt for variables before drawing your segments using entmake.

 

Sent from my Pixel XL using Tapatalk

[BIGAL]

I think your rule is a little rubbery no pun intended what would be best is to nominate number required with a gap this will give the length of each section.

 

Not much thought to this but length = num*dist - (num*2*gap) is gap ok ? else dist has to be redone.

 

Redoing the line and arc is actually the easiest bit once the rules are worked out. Having a rubber band of 1/4 or 1/2 range may be problem. What happens when this rule is not met.

 

Can you post some samples in a dwg.

[troggarf]

I use this routine from Alan Thompson to break along an object (curves included)

(defun c:BAD (/ *error* AT:GetSel AT:DrawX _getDist ent pnt cmd undo total add dist break)
 ;; Break curve At Distance
 ;; Alan J. Thompson, 09.21.11
 ;; http://www.theswamp.org/index.php?topic=39550.0;all
 (vl-load-com)

 (defun *error* (msg)
   (and cmd (setvar 'CMDECHO cmd))
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (defun AT:GetSel (meth msg fnc / ent)
   ;; meth - selection method (entsel, nentsel, nentselp)
   ;; msg - message to display (nil for default)
   ;; fnc - optional function to apply to selected object
   ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
   ;; Alan J. Thompson, 05.25.10
   (setvar 'ERRNO 0)
   (while
     (progn (setq ent (meth (cond (msg)
                                  ("\nSelect object: ")
                            )
                      )
            )
            (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                  ((eq (type (car ent)) 'ENAME)
                   (if (and fnc (not (fnc ent)))
                     (princ "\nInvalid object!")
                   )
                  )
            )
     )
   )
   ent
 )

 (defun AT:DrawX (P C)
   ;; Draw and "X" vector at specified point
   ;; P - Placement point for "X"
   ;; C - Color of "X" (must be integer b/w 1 & 255)
   ;; Alan J. Thompson, 10.31.09
   (if (vl-consp P)
     ((lambda (d)
        (grvecs (cons C
                      (mapcar (function (lambda (n) (polar P (* n pi) d)))
                              '(0.25 1.25 0.75 1.75)
                      )
                )
        )
        P
      )
       (* (getvar 'viewsize) 0.02)
     )
   )
 )

 (defun _getDist (total point / dist)
   (and undo (initget "Undo"))
   (cond ((not (setq dist (getdist (AT:DrawX point 4)
                                   (strcat
                                     "\nDistance at which to break curve (Total= "
                                     (rtos total)
                                     (if undo
                                       ") [undo]: "
                                       "): "
                                     )
                                   )
                          )
               )
          )
          nil
         )
         ((eq dist "Undo") dist)
         ((not (< 0. dist total))
          (princ (strcat "\nValue must be between 0.0 and and " (rtos total) "!"))
          (_getDist total point)
         )
         (dist)
   )
 )

 (vla-startundomark
   (cond (*AcadDoc*)
         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
   )
 )


 (if (setq ent (AT:GetSel
                 entsel
                 "\nSelect curve to break: "
                 (lambda (x)
                   (and (wcmatch (cdr (assoc 0 (entget (car x))))
                                 "ARC,LINE,*POLYLINE,SPLINE"
                        )
                        (not (vlax-curve-isClosed (car x)))
                   )
                 )
               )
     )
   (progn
     (setq pnt (trans (cadr ent) 1 0)
           ent (car ent)
           cmd (getvar 'CMDECHO)
     )
     (setvar 'CMDECHO 0)
     (while
       (setq
         dist (_getDist (setq total (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
                        (setq pnt
                               (trans (if (> (vlax-curve-getParamAtPoint
                                               ent
                                               (vlax-curve-getClosestPointToProjection ent pnt '(0. 0. 1.))
                                             )
                                             (vlax-curve-getParamAtDist ent (/ total 2.))
                                          )
                                        (progn (setq add total) (vlax-curve-getEndPoint ent))
                                        (progn (setq add 0.) (vlax-curve-getStartPoint ent))
                                      )
                                      0
                                      1
                               )
                        )
              )
       )
        (if (eq dist "Undo")
          (progn (vl-cmdf "_.U")
                 (setq ent  (caar undo)
                       pnt  (cadar undo)
                       undo (cdr undo)
                 )
          )
          (progn
            (setq break (trans (vlax-curve-getPointAtDist ent (abs (- add dist))) 0 1))
            (command-s "_.break" ent "_F" "_non" break "_non" break)
            (setq undo (cons (list ent pnt) undo))
            (and (zerop add) (setq ent (entlast)))
          )
        )
        (redraw)
        (foreach p (vl-remove (last undo) undo) (AT:DrawX (cadr p) 1))
     )
   )
 )
 (*error* nil)
 (princ)
)