Jump to content

Arrange the wires with a constant offset

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted (edited) 
;; Arrange the wires with a constant offset - exceed 2022.01.17
;; ARRY : Arrange the Horizontal Lines with a constant offset (in Y-AXIS)
;; ARRX : Arrange the Vertical Lines with a constant offset (in X-AXIS)
;; ARRYV : Arrange the Horizontal Lines with a input offset (in Y-AXIS)
;; ARRXV : Arrange the Vertical Lines with a input offset (in X-AXIS)


(vl-load-com)
(defun c:ARRY ( / ss startpt endpt ssl ssindex sety d gap sslist ssstacklist ssent ssobj orderindex ordery sety orderent orderobj startx startz startpoint endx endz endpoint testlist ss2 ss2length subindex subent subobj substartx substartz substartpoint ss3 ss3length   )
(princ "\n Arrange the Lines with a constant offset (in Y-AXIS) \n Select Horizontal Lines to Arrange ")
(setq ss (ssget ":L" '((0 . "LINE"))))
(setq startpt (getpoint "\n Specify Space - Pick Start Point "))
(setq endpt (getpoint "\n Specify Space - Pick End Point "))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )




(setq ssl (sslength ss))
(setq ssindex 0)
(setq sety (cadr startpt))

(setq d (abs (- (cadr startpt) (cadr endpt)) ))
(setq gap (/ d (+ ssl 1)))
(setq sslist nil)
(setq ssstacklist nil)

(repeat ssl
 (setq ssent (entget (ssname ss ssindex)))
 (setq sslist (list (car (cdr (cdr (assoc 10 ssent)))) ssindex))
 (setq ssstacklist (cons sslist ssstacklist))
 (setq ssindex (+ ssindex 1))
)

;(princ ssstacklist)

  ;sort ssstacklist
  (setq ssstacklist (vl-sort ssstacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ ssstacklist)

(setq index 0)
(cond
 ((> (cadr startpt) (cadr endpt)) (setq sety (cadr endpt)))
 ((<= (cadr startpt) (cadr endpt)) (setq sety (cadr startpt)))
)
 (setq sety (+ sety gap))
;(princ sety)
 (setq testlist nil)


(repeat ssl 
 (setq testlist nil)
 (setq orderindex (cdr (nth index ssstacklist)))
 (setq ordery (car (nth index ssstacklist)))
 ;(princ ordery)


 (setq orderent (entget (ssname ss (car orderindex))))
 (setq orderobj (vlax-ename->vla-object (ssname ss (car orderindex))))

 (setq startx (cadr (assoc 10 orderent)))
 (setq startz (cadddr (assoc 10 orderent)))
 (setq startpoint (list startx sety startz))

 (setq endx (cadr (assoc 11 orderent)))
 (setq endz (cadddr (assoc 11 orderent)))
 (setq endpoint (list endx sety endz))
 (setq testlist (list 0.0 ordery 0.0))



 ;(princ testlist)



(vla-put-startpoint orderobj (vlax-3d-point startpoint))
(vla-put-endpoint orderobj (vlax-3d-point endpoint))

(setq ss3 nil)
 (setq ss3 (ssget "_X" (list '(-4 . "*,=,*") (cons 11 testlist) (cons 0 "line"))) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
(setq ss2 nil)
(setq ss2 (ssget "_X" (list '(-4 . "*,=,*") (cons 10 testlist) (cons 0 "line"))) )
(setq ss2 (ssget "_P" (layerfilter 7)))

 (setq ss2length 0)
(setq ss2length (sslength ss2))
;(princ "\n ss2length - ")
;(princ ss2length)
(cond 
  ((< 0 (sslength ss2)) 
   (progn 
     (setq ss2length (sslength ss2))
    ;(princ (vl-princ-to-string ss2length))
     (setq subindex 0)
     (repeat ss2length
       (setq subent (entget (ssname ss2 subindex)))
       (setq subobj (vlax-ename->vla-object (ssname ss2 subindex)))
       (setq substartx (cadr (assoc 10 subent)))
       (setq substarty (caddr (assoc 10 subent)))
       (setq substartz (cadddr (assoc 10 subent)))
       (setq substartpoint (list substartx sety substartz))
       (setq suboriginstartpoint (list substartx substarty substartz))
       ;(princ "\n substartpoint ")
       ;(princ substartpoint)
       (if (and (/= orderent subent) (= ordery substarty) (<= substartx (apply 'max (list endx startx))) (>= substartx (apply 'min (list endx startx))))
       (progn (vla-put-startpoint subobj (vlax-3d-point substartpoint)))
       ;(progn (vla-put-startpoint subobj (vlax-3d-point suboriginstartpoint)))
       )
       (setq subindex (+ subindex 1))
      )
    ))
   ((= 0 (sslength ss2))
   (princ "\n no strat line ")
   )
)


 (setq ss3length 0)
 (setq ss3length (sslength ss3))
;(princ "\n ss3length - ")
;(princ ss3length)
(cond
 ((< 0 (sslength ss3))
   (progn 
     (setq ss3length (sslength ss3))
     (setq subindex2 0)
     (repeat ss3length
       (setq subent3 (entget (ssname ss3 subindex2)))
       (setq subobj3 (vlax-ename->vla-object (ssname ss3 subindex2)))
       (setq subendx3 (cadr (assoc 11 subent3)))
       (setq subendy3 (caddr (assoc 11 subent3)))
       (setq subendz3 (cadddr (assoc 11 subent3)))
       (setq subendpoint3 (list subendx3 sety subendz3))
       (setq suboriginendpoint3 (list subendx3 subendy3 subendz3))
       ;(princ "\n subendpoint ")
       ;(princ subendpoint3)
       (if (and (/= orderent subent3) (= ordery subendy3)  (<= subendx3 (apply 'max (list endx startx))) (>= subendx3 (apply 'min (list endx startx))))
       (progn (vla-put-endpoint subobj3 (vlax-3d-point subendpoint3)))
       ;(progn (vla-put-endpoint subobj3 (vlax-3d-point suboriginendpoint3)))
       )
       (setq subindex2 (+ subindex2 1))
     )
   ))
   ((= 0 (sslength ss3))
   (princ "\n no end line ")
   )
 )




 (setq sety (+ sety gap))
 (setq index (+ index 1))
)
(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result - " (vl-princ-to-string ssl) " lines in " (vl-princ-to-string d) " space aligned with " (vl-princ-to-string gap) " spacing."))

(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
)


(defun c:ARRX ( / ss startpt endpt ssl ssindex setx d gap sslist ssstacklist ssent ssobj orderindex orderx orderent orderobj starty startz startpoint endy endz endpoint testlist ss2 ss2length subindex subent subobj substartx substartz substartpoint ss3 ss3length   )
(princ "\n Arrange the Lines with a constant offset (in X-AXIS) \n Select Vertical Lines to Arrange ")
(setq ss (ssget ":L" '((0 . "LINE"))))
(setq startpt (getpoint "\n Specify Space - Pick Start Point "))
(setq endpt (getpoint "\n Specify Space - Pick End Point "))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )



(setq ssl (sslength ss))
(setq ssindex 0)
(setq setx (car startpt))

(setq d (abs (- (car startpt) (car endpt)) ))
(setq gap (/ d (+ ssl 1)))
(setq sslist nil)
(setq ssstacklist nil)

(repeat ssl
 (setq ssent (entget (ssname ss ssindex)))
 (setq sslist (list (cadr (assoc 10 ssent)) ssindex))
 (setq ssstacklist (cons sslist ssstacklist))
 (setq ssindex (+ ssindex 1))
)

;(princ ssstacklist)

  ;sort ssstacklist
  (setq ssstacklist (vl-sort ssstacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ ssstacklist)

(setq index 0)
(cond
 ((> (car startpt) (car endpt)) (setq sety (car endpt)))
 ((<= (car startpt) (car endpt)) (setq sety (car startpt)))
)
 (setq setx (+ setx gap))
;(princ setx)
 (setq testlist nil)



(repeat ssl 
 (setq testlist nil)
 (setq orderindex (cdr (nth index ssstacklist)))
 (setq orderx (car (nth index ssstacklist)))
 ;(princ ordery)


 (setq orderent (entget (ssname ss (car orderindex))))
 (setq orderobj (vlax-ename->vla-object (ssname ss (car orderindex))))

 (setq starty (caddr (assoc 10 orderent)))
 (setq startz (cadddr (assoc 10 orderent)))
 (setq startpoint (list setx starty startz))

 (setq endy (caddr (assoc 11 orderent)))
 (setq endz (cadddr (assoc 11 orderent)))
 (setq endpoint (list setx endy endz))
 (setq testlist (list orderx 0.0 0.0))
 ;(princ testlist)




 (vla-put-startpoint orderobj (vlax-3d-point startpoint))
 (vla-put-endpoint orderobj (vlax-3d-point endpoint))



(setq ss3 nil)
 (setq ss3 (ssget "_X" (list '(-4 . "=,*,*") (cons 11 testlist) (cons 0 "line"))) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
(setq ss2 nil)
 (setq ss2 (ssget "_X" (list '(-4 . "=,*,*") (cons 10 testlist) (cons 0 "line"))) )
 (setq ss2 (ssget "_P" (layerfilter 7)))

 (setq ss2length 0)
(setq ss2length (sslength ss2))
;(princ "\n ss2length - ")
;(princ ss2length)
(cond 
  ((< 0 (sslength ss2)) 
   (progn 
     (setq ss2length (sslength ss2))
    ;(princ (vl-princ-to-string ss2length))
     (setq subindex 0)
     (repeat ss2length
       (setq subent (entget (ssname ss2 subindex)))
       (setq subobj (vlax-ename->vla-object (ssname ss2 subindex)))
       (setq substartx (cadr (assoc 10 subent)))
       (setq substarty (caddr (assoc 10 subent)))
       (setq substartz (cadddr (assoc 10 subent)))
       (setq substartpoint (list setx substarty substartz))
       (setq suboriginalstartpoint (list substartx substarty substartz))
       ;(princ "\n substartpoint ")
       ;(princ substartpoint)
       (if (and (/= orderent subent) (= orderx substartx)(<= substarty (apply 'max (list endy starty))) (>= substarty (apply 'min (list endy starty))))
       (progn (vla-put-startpoint subobj (vlax-3d-point substartpoint)))
       ;(progn (vla-put-startpoint subobj (vlax-3d-point suboriginstartpoint)))
       )
       (setq subindex (+ subindex 1))
      )
    ))
   ((= 0 (sslength ss2))
   (princ "\n no strat line ")
   )
)


 (setq ss3length 0)
 (setq ss3length (sslength ss3))
;(princ "\n ss3length - ")
;(princ ss3length)

(cond
 ((< 0 (sslength ss3))
   (progn 
     (setq ss3length (sslength ss3))
     (setq subindex2 0)
     (repeat ss3length
       (setq subent3 (entget (ssname ss3 subindex2)))
       (setq subobj3 (vlax-ename->vla-object (ssname ss3 subindex2)))
       (setq subendx3 (cadr (assoc 11 subent3)))
       (setq subendy3 (caddr (assoc 11 subent3)))
       (setq subendz3 (cadddr (assoc 11 subent3)))
       (setq subendpoint3 (list setx subendy3 subendz3))
       (setq suboriginalendpoint3 (list subendx3 subendy3 subendz3))
       ;(princ "\n subendpoint ")
       ;(princ subendpoint3)
       (if (and (/= orderent subent3) (= orderx subendx3)(<= subendy3 (apply 'max (list endy starty))) (>= subendy3 (apply 'min (list endy starty))))
       (progn (vla-put-endpoint subobj3 (vlax-3d-point subendpoint3)))
       ;(progn (vla-put-endpoint subobj3 (vlax-3d-point suboriginalendpoint3)))
       )
       (setq subindex2 (+ subindex2 1))
     )
   ))
   ((= 0 (sslength ss3))
   (princ "\n no end line ")
   )
 )


 (setq setx (+ setx gap))
 (setq index (+ index 1))
)
(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result - " (vl-princ-to-string ssl) " lines in " (vl-princ-to-string d) " space aligned with " (vl-princ-to-string gap) " spacing."))

(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)

)


(defun c:ARRYV ( / ss startpt endpt ssl ssindex sety d gap sslist ssstacklist ssent ssobj orderindex ordery sety orderent orderobj startx startz startpoint endx endz endpoint testlist ss2 ss2length subindex subent subobj substartx substartz substartpoint ss3 ss3length   )
(princ "\n Arrange the Lines with a constant offset (in Y-AXIS) \n Select Horizontal Lines to Arrange ")
(setq ss (ssget ":L" '((0 . "LINE"))))
(setq startpt (getpoint "\n Specify Space - Pick Start Point "))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )




(setq ssl (sslength ss))
(setq ssindex 0)
(setq sety (cadr startpt))


(setq gap (getreal "\n Input Spacing Gap "))
(setq sslist nil)
(setq ssstacklist nil)

(repeat ssl
 (setq ssent (entget (ssname ss ssindex)))
 (setq sslist (list (car (cdr (cdr (assoc 10 ssent)))) ssindex))
 (setq ssstacklist (cons sslist ssstacklist))
 (setq ssindex (+ ssindex 1))
)

;(princ ssstacklist)

  ;sort ssstacklist
  (setq ssstacklist (vl-sort ssstacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ ssstacklist)

(setq index 0)
;(cond
; ((> (cadr startpt) (cadr endpt)) (setq sety (cadr endpt)))
; ((<= (cadr startpt) (cadr endpt)) (setq sety (cadr startpt)))
;)
 (setq sety (+ sety gap))
;(princ sety)
 (setq testlist nil)


(repeat ssl 
 (setq testlist nil)
 (setq orderindex (cdr (nth index ssstacklist)))
 (setq ordery (car (nth index ssstacklist)))
 ;(princ ordery)


 (setq orderent (entget (ssname ss (car orderindex))))
 (setq orderobj (vlax-ename->vla-object (ssname ss (car orderindex))))

 (setq startx (cadr (assoc 10 orderent)))
 (setq startz (cadddr (assoc 10 orderent)))
 (setq startpoint (list startx sety startz))

 (setq endx (cadr (assoc 11 orderent)))
 (setq endz (cadddr (assoc 11 orderent)))
 (setq endpoint (list endx sety endz))
 (setq testlist (list 0.0 ordery 0.0))



 ;(princ testlist)



(vla-put-startpoint orderobj (vlax-3d-point startpoint))
(vla-put-endpoint orderobj (vlax-3d-point endpoint))

(setq ss3 nil)
 (setq ss3 (ssget "_X" (list '(-4 . "*,=,*") (cons 11 testlist) (cons 0 "line"))) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
(setq ss2 nil)
(setq ss2 (ssget "_X" (list '(-4 . "*,=,*") (cons 10 testlist) (cons 0 "line"))) )
(setq ss2 (ssget "_P" (layerfilter 7)))

 (setq ss2length 0)
(setq ss2length (sslength ss2))
;(princ "\n ss2length - ")
;(princ ss2length)
(cond 
  ((< 0 (sslength ss2)) 
   (progn 
     (setq ss2length (sslength ss2))
    ;(princ (vl-princ-to-string ss2length))
     (setq subindex 0)
     (repeat ss2length
       (setq subent (entget (ssname ss2 subindex)))
       (setq subobj (vlax-ename->vla-object (ssname ss2 subindex)))
       (setq substartx (cadr (assoc 10 subent)))
       (setq substarty (caddr (assoc 10 subent)))
       (setq substartz (cadddr (assoc 10 subent)))
       (setq substartpoint (list substartx sety substartz))
       (setq suboriginstartpoint (list substartx substarty substartz))
       ;(princ "\n substartpoint ")
       ;(princ substartpoint)
       (if (and (/= orderent subent) (= ordery substarty) (<= substartx (apply 'max (list endx startx))) (>= substartx (apply 'min (list endx startx))))
       (progn (vla-put-startpoint subobj (vlax-3d-point substartpoint)))
       ;(progn (vla-put-startpoint subobj (vlax-3d-point suboriginstartpoint)))
       )
       (setq subindex (+ subindex 1))
      )
    ))
   ((= 0 (sslength ss2))
   (princ "\n no strat line ")
   )
)


 (setq ss3length 0)
 (setq ss3length (sslength ss3))
;(princ "\n ss3length - ")
;(princ ss3length)
(cond
 ((< 0 (sslength ss3))
   (progn 
     (setq ss3length (sslength ss3))
     (setq subindex2 0)
     (repeat ss3length
       (setq subent3 (entget (ssname ss3 subindex2)))
       (setq subobj3 (vlax-ename->vla-object (ssname ss3 subindex2)))
       (setq subendx3 (cadr (assoc 11 subent3)))
       (setq subendy3 (caddr (assoc 11 subent3)))
       (setq subendz3 (cadddr (assoc 11 subent3)))
       (setq subendpoint3 (list subendx3 sety subendz3))
       (setq suboriginendpoint3 (list subendx3 subendy3 subendz3))
       ;(princ "\n subendpoint ")
       ;(princ subendpoint3)
       (if (and (/= orderent subent3) (= ordery subendy3)  (<= subendx3 (apply 'max (list endx startx))) (>= subendx3 (apply 'min (list endx startx))))
       (progn (vla-put-endpoint subobj3 (vlax-3d-point subendpoint3)))
       ;(progn (vla-put-endpoint subobj3 (vlax-3d-point suboriginendpoint3)))
       )
       (setq subindex2 (+ subindex2 1))
     )
   ))
   ((= 0 (sslength ss3))
   (princ "\n no end line ")
   )
 )




 (setq sety (+ sety gap))
 (setq index (+ index 1))
)
(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result : " (vl-princ-to-string ssl) " lines aligned from Y-coord " (vl-princ-to-string (cadr startpt)) " with " (vl-princ-to-string gap) " spacing."))
(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)

)


(defun c:ARRXV ( / ss startpt endpt ssl ssindex setx d gap sslist ssstacklist ssent ssobj orderindex orderx orderent orderobj starty startz startpoint endy endz endpoint testlist ss2 ss2length subindex subent subobj substartx substartz substartpoint ss3 ss3length   )
(princ "\n Arrange the Lines with a constant offset (in X-AXIS) \n Select Vertical Lines to Arrange ")
(setq ss (ssget ":L" '((0 . "LINE"))))
(setq startpt (getpoint "\n Specify Space - Pick Start Point "))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )


(setq ssl (sslength ss))
(setq ssindex 0)
(setq setx (car startpt))

(setq gap (getreal "\n Input Spacing Gap "))
(setq sslist nil)
(setq ssstacklist nil)

(repeat ssl
 (setq ssent (entget (ssname ss ssindex)))
 (setq sslist (list (cadr (assoc 10 ssent)) ssindex))
 (setq ssstacklist (cons sslist ssstacklist))
 (setq ssindex (+ ssindex 1))
)

;(princ ssstacklist)

  ;sort ssstacklist
  (setq ssstacklist (vl-sort ssstacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ ssstacklist)

(setq index 0)
;(cond
; ((> (car startpt) (car endpt)) (setq sety (car endpt)))
; ((<= (car startpt) (car endpt)) (setq sety (car startpt)))
;)
 (setq setx (+ setx gap))
;(princ setx)
 (setq testlist nil)



(repeat ssl 
 (setq testlist nil)
 (setq orderindex (cdr (nth index ssstacklist)))
 (setq orderx (car (nth index ssstacklist)))
 ;(princ ordery)


 (setq orderent (entget (ssname ss (car orderindex))))
 (setq orderobj (vlax-ename->vla-object (ssname ss (car orderindex))))

 (setq starty (caddr (assoc 10 orderent)))
 (setq startz (cadddr (assoc 10 orderent)))
 (setq startpoint (list setx starty startz))

 (setq endy (caddr (assoc 11 orderent)))
 (setq endz (cadddr (assoc 11 orderent)))
 (setq endpoint (list setx endy endz))
 (setq testlist (list orderx 0.0 0.0))
 ;(princ testlist)




 (vla-put-startpoint orderobj (vlax-3d-point startpoint))
 (vla-put-endpoint orderobj (vlax-3d-point endpoint))



(setq ss3 nil)
 (setq ss3 (ssget "_X" (list '(-4 . "=,*,*") (cons 11 testlist) (cons 0 "line"))) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
(setq ss2 nil)
 (setq ss2 (ssget "_X" (list '(-4 . "=,*,*") (cons 10 testlist) (cons 0 "line"))) )
 (setq ss2 (ssget "_P" (layerfilter 7)))

 (setq ss2length 0)
(setq ss2length (sslength ss2))
;(princ "\n ss2length - ")
;(princ ss2length)
(cond 
  ((< 0 (sslength ss2)) 
   (progn 
     (setq ss2length (sslength ss2))
    ;(princ (vl-princ-to-string ss2length))
     (setq subindex 0)
     (repeat ss2length
       (setq subent (entget (ssname ss2 subindex)))
       (setq subobj (vlax-ename->vla-object (ssname ss2 subindex)))
       (setq substartx (cadr (assoc 10 subent)))
       (setq substarty (caddr (assoc 10 subent)))
       (setq substartz (cadddr (assoc 10 subent)))
       (setq substartpoint (list setx substarty substartz))
       (setq suboriginalstartpoint (list substartx substarty substartz))
       ;(princ "\n substartpoint ")
       ;(princ substartpoint)
       (if (and (/= orderent subent) (= orderx substartx)(<= substarty (apply 'max (list endy starty))) (>= substarty (apply 'min (list endy starty))))
       (progn (vla-put-startpoint subobj (vlax-3d-point substartpoint)))
       ;(progn (vla-put-startpoint subobj (vlax-3d-point suboriginstartpoint)))
       )
       (setq subindex (+ subindex 1))
      )
    ))
   ((= 0 (sslength ss2))
   (princ "\n no strat line ")
   )
)


 (setq ss3length 0)
 (setq ss3length (sslength ss3))
;(princ "\n ss3length - ")
;(princ ss3length)

(cond
 ((< 0 (sslength ss3))
   (progn 
     (setq ss3length (sslength ss3))
     (setq subindex2 0)
     (repeat ss3length
       (setq subent3 (entget (ssname ss3 subindex2)))
       (setq subobj3 (vlax-ename->vla-object (ssname ss3 subindex2)))
       (setq subendx3 (cadr (assoc 11 subent3)))
       (setq subendy3 (caddr (assoc 11 subent3)))
       (setq subendz3 (cadddr (assoc 11 subent3)))
       (setq subendpoint3 (list setx subendy3 subendz3))
       (setq suboriginalendpoint3 (list subendx3 subendy3 subendz3))
       ;(princ "\n subendpoint ")
       ;(princ subendpoint3)
       (if (and (/= orderent subent3) (= orderx subendx3)(<= subendy3 (apply 'max (list endy starty))) (>= subendy3 (apply 'min (list endy starty))))
       (progn (vla-put-endpoint subobj3 (vlax-3d-point subendpoint3)))
       ;(progn (vla-put-endpoint subobj3 (vlax-3d-point suboriginalendpoint3)))
       )
       (setq subindex2 (+ subindex2 1))
     )
   ))
   ((= 0 (sslength ss3))
   (princ "\n no end line ")
   )
 )


 (setq setx (+ setx gap))
 (setq index (+ index 1))
)
(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result - " (vl-princ-to-string ssl) " lines aligned from X-coord " (vl-princ-to-string (car startpt)) " with " (vl-princ-to-string gap) " spacing."))

(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)

(princ)

)


;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc_forrf 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc_forrf)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo_forrf doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)


(defun layerfilter ( bit / lst )
    (if (setq lst (layerlist bit))
        (append
           '((-4 . "<NOT") (-4 . "<OR"))
            (mapcar '(lambda ( x ) (cons 8 (LM:escapewildcards x))) lst)
           '((-4 . "OR>") (-4 . "NOT>"))
        )
    )
)
 
(defun layerlist ( bit / lay rtn )
    (while (setq lay (tblnext "layer" (not lay)))
        (if (or (= 1 (logand 1 bit) (logand 1 (cdr (assoc 70 lay))))
                (= 4 (logand 4 bit) (logand 4 (cdr (assoc 70 lay))))
                (and (= 2 (logand 2 bit)) (minusp (cdr (assoc 62 lay))))
            )
            (setq rtn (cons (cdr (assoc 2 lay)) rtn))
        )
    )
    (reverse rtn)
)
 
;; Escape Wildcards  -  Lee Mac
;; Escapes wildcard special characters in a supplied string
 
(defun LM:escapewildcards ( str )
    (vl-list->string
        (apply 'append
            (mapcar
               '(lambda ( c )
                    (if (member c '(35 64 46 42 63 126 91 93 45 44))
                        (list 96 c)
                        (list c)
                    )
                )
                (vl-string->list str)
            )
        )
    )
)

 

ARRY : Arrange Horizontal Lines in Y AXIS 

ARRX : Arrange Vertical Lines in X AXIS 

ARRYV : ARRY with start-point & gap-distance-input. ( plus : go up / minus : go down )

ARRXV : ARRX with start-point & gap-distance-input. ( plus : go right / minus : go left )

 

1.thumb.PNG.6dffddef3d8a39475a61885d16e77a55.PNG

 

1. Select only horizontal wires to be arranged

2. Select the space by picking 2 points (extract the y value, the order does not matter)

 

2.thumb.PNG.6beaf04db8617a9b1b9fd5e844b50e2d.PNG

3. complete

 

 

 

3.thumb.PNG.13e69eb9f366f48c661b874c15a1774b.PNG

4. range doesn't matter

 

I had to stretch several times after making sketches that were not evenly spaced. So I made this.

 

The way it works is to get the y-coordinate of the selected lines

and divide the limit range so that there is 1 more than the number of lines

and arrange them.

Also, find the lines that have the y value of the line as the end point or the start point and move them together. (for elbow or tee)

It would be good to add a method to set the offset from the starting point rather than dividing it uniformly, and also a method to execute with the x coordinate.

 

However, it can be a bit slow because it searches the entire line.

but this is made for relatively simple logic diagrams or loop diagrams.

 

Originally I wanted to do the stretch multiple times with an offset.

But I don't know how stretch gets and modifies the specific vertices of a polyline. 

So, I wrote a basic lisp with only line.

If you have any good ideas, please let me know. 

thank you for reading

 

 

+

edit - set limit

edit - error fix

Edited by exceed
set limit
exceed Proficient

exceed

Posted
  • Author
Posted (edited) 
;; Arrange the horizontal lwpolylines with a constant offset in Y-axis range - exceed 2022.01.19
;; ARRYP : Arrange the Horizontal LWPOLYLINES with a constant offset (in Y-AXIS)
;; ARRXP : Arrange the Vertical LWPOLYLINES with a constant offset (in X-AXIS)
;; ARRYVP : Arrange the Horizontal LWPOLYLINES with a input offset (in Y-AXIS)
;; ARRXVP : Arrange the Vertical LWPOLYLINES with a input offset (in X-AXIS)


(defun c:ARRYP ( / ss ssl index edatastacklist ptymin startrange endrange startpt endpt startpty endpty d ptymin gap startrangex startrangey endrangex endrangey xmin xmax ymin ymax vstacklist ydatastacklist edata arcdata edatalen verticeindex ycoordmin nowptforrad radindex ang degang oldptforrad ydata ydatastacklist ydatalen ydataindex plusgapstack plusgap edatastacklist edatastacklistlen edatastacklistindex editlineno gapy editent editverticecoord evcx evcy setcoord )
(princ "\n Select Horizontal Polylines to arrange ")
(setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))



  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )


(setq ssl (sslength ss))
(setq index 0)
(setq edatastacklist nil)
(setq ptymin 0)
(setq startpty 0)
(setq endpty 0)

(setq startrange (getpoint "\n Set Start Range of vertices to Stretch "))
(setq endrange (getpoint "\n Set End Range of vertices to Stretch "))


(setq startpt (getpoint "\n Set Arrange Y-axis Area 1st Point "))
(setq endpt (getpoint "\n Set Arrange Y-axis Area 2nd Point "))
(setq startpty (cadr startpt))
(setq endpty (cadr endpt))
(setq d (abs (- startpty endpty )))
(setq ptymin (apply 'min (list startpty endpty)))

;(princ "\n ptymin")
;(princ ptymin)
(setq gap (/ d (+ ssl 1)))
;(princ "\n gap")
;(princ gap)

(setq ptymin (+ ptymin gap))
;(princ "\n ptymin")
;(princ ptymin)


(setq startrangex (car startrange))
(setq startrangey (cadr startrange))
(setq endrangex (car endrange))
(setq endrangey (cadr endrange))
(setq xmin (apply 'min (list startrangex endrangex)))
(setq xmax (apply 'max (list startrangex endrangex)))
(setq ymin (apply 'min (list startrangey endrangey)))
(setq ymax (apply 'max (list startrangey endrangey)))

;(princ (list xmin ymin))
;(princ (list xmax ymax))


(setq vstacklist nil)
(setq ydatastacklist nil)

;(setq ss2 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )


(repeat ssl

(setq edata (entget (ssname ss index)))
;(ssdel (ssname ss index) ss2)
(setq edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))
(setq arcdata (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget (ssname ss index))))
;(princ "\n arcdata - ")
;(princ arcdata)
(setq edatalen (length edata))
(setq verticeindex 0)
(setq ycoordmin ymax)
;(setq ycoordcompare 0)
;(setq ystack nil)
  (repeat edatalen
    (setq vdata (list index verticeindex (nth verticeindex edata)))
    ;(setq ycoord (caddr (nth verticeindex edata)))
    (if (and (and (<= (cadr (nth verticeindex edata)) xmax) (>= (cadr (nth verticeindex edata)) xmin)) (and (<= (caddr (nth verticeindex edata)) ymax) (>= (caddr (nth verticeindex edata)) ymin)))
       (progn (setq vstacklist (cons vdata vstacklist))) ;(setq ystack (cons ycoord ystack)))
    
    )
    (setq verticeindex (+ verticeindex 1))
  )
(setq nowptforrad (cdr (nth 0 edata)))
;(princ nowptforrad)
(setq radindex 1)
(setq ang 0)
(setq degang 0)
  (repeat (- edatalen 1)
     (setq oldptforrad nowptforrad)
     (setq nowptforrad (cdr (nth radindex edata)))
     ;(princ nowptforrad)
     (setq ang (angle (trans oldptforrad 1 0) (trans nowptforrad 1 0) ) )
     (setq degang (/ (* ang 180.0) pi))
     (if (and (or (and (<= degang 1) (>= degang -1)) (and (<= degang 361) (>= degang 359)) (and (<= degang 181) (>= degang 179))) (and (<= (cadr (nth radindex edata)) xmax) (>= (cadr (nth radindex edata)) xmin)) (and (<= (caddr (nth radindex edata)) ymax) (>= (caddr (nth radindex edata)) ymin)))
        (setq ycoordmin (caddr (nth radindex edata)))
      
     )
     ;(princ "\n angle = ")
     ;(princ degang)
     ;(princ ycoordmin)
     (setq radindex (+ radindex 1))
  )
 



;(princ "\n ycoordmin ")
;(princ ycoordmin)
;(setq ycoordmin (car (LM:ListDupes ystack)))
(setq ydata (list ycoordmin index))
(setq ydatastacklist (cons ydata ydatastacklist))
(setq index (+ index 1))
)

;(princ ydatastacklist)
  (setq ydatastacklist (vl-sort ydatastacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )
;(princ "\n ydatastacklist")
;(princ ydatastacklist)


(setq ydatalen (length ydatastacklist))
(setq ydataindex 0)
(setq plusgapstack nil)
(repeat ydatalen
 (setq plusgap (list (cadr (nth ydataindex ydatastacklist)) (car (nth ydataindex ydatastacklist)) (- (car (nth ydataindex ydatastacklist)) ptymin) ))
 (setq plusgapstack (cons plusgap plusgapstack))
 (setq ydataindex (+ ydataindex 1))
 (setq ptymin (+ ptymin gap))
)
(setq plusgapstack (reverse plusgapstack))


  (setq plusgapstack (vl-sort plusgapstack
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ "\n plusgap")
;(princ plusgapstack)
(setq edatastacklist (reverse vstacklist))
;(princ "\n edatastack")
;(princ edatastacklist)

(setq edatastacklistlen (length edatastacklist))
(setq edatastacklistindex 0)

(repeat edatastacklistlen
  (setq editlineno (car (nth edatastacklistindex edatastacklist)))
  (setq gapy (caddr (nth editlineno plusgapstack)))
  ;(princ gapy)
  ;(princ editlineno)
  (setq editent (entget (ssname ss editlineno)))
  ;(princ editent)
  (setq editverticecoord (caddr (nth edatastacklistindex edatastacklist)))
  (setq evcx (cadr editverticecoord))
  (setq evcy (caddr editverticecoord))
  (setq evcy (- evcy gapy))
  (setq setcoord (cons 10 (list evcx evcy) ) )
  (setq editent (entmod (subst setcoord editverticecoord editent)))
;  (setq editent (entmod (subst '(10 0.0 0.0) editverticecoord editent)))
  (entupd (cdr (assoc -1 editent)))
  (setq edatastacklistindex (+ edatastacklistindex 1))
)

;;;today edited
;(setq ss2l (sslength ss2))
;(princ "\n ss2 length - ")
;(princ ss2l)

(setq plusgapl (length plusgapstack))
(setq pgindex 0)
(repeat plusgapl
 (setq plusgapy (cadr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapy - ")
 ;(princ plusgapy)
 (setq plusgapydelta (caddr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapydelta - ")
 ;(princ plusgapydelta)


 (setq ss3 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
 (setq index 0)
   (repeat ssl
      (ssdel (ssname ss index) ss3)
      (setq index (+ index 1))
   )
 (setq ss3l (sslength ss3))
;(princ "\n ss3 length - ")
;(princ ss3l)

 (setq ss3index 0)
   (repeat ss3l
     (setq ss3editent (entget (ssname ss3 ss3index)))
     (setq ss3edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss3editent))
     ;(princ "\n ss3edata filtered assoc 10 - ")
     ;(princ ss3edata)
     (setq ss3edatalen (length ss3edata))
     (setq ss3vindex 0)
        (repeat ss3edatalen
           (setq ss3vdata (list ss3index ss3vindex (nth ss3vindex ss3edata)))
           ;(princ "\n ss3vdata - ")
           ;(princ ss3vdata)
           (if (= plusgapy (caddr (nth ss3vindex ss3edata)))
              (progn 
                 (setq editverticecoord2 (nth ss3vindex ss3edata))
                 (setq evcx2 (cadr editverticecoord2))
                 (setq evcy2 (caddr editverticecoord2))
                 (setq evcy2 (- evcy2 plusgapydelta))
                 (setq setcoord2 (cons 10 (list evcx2 evcy2) ) )
                 (setq ss3editent (entmod (subst setcoord2 editverticecoord2 ss3editent)))
                 (entupd (cdr (assoc -1 ss3editent)))
              )
       
           )
           (setq ss3vindex (+ ss3vindex 1))
         )
     (setq ss3index (+ ss3index 1))
  )

 (setq pgindex (+ pgindex 1))
)

(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result - " (vl-princ-to-string ssl) " lines in " (vl-princ-to-string d) " space aligned with " (vl-princ-to-string gap) " spacing."))


(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)

(princ)
)



(defun c:ARRXP ( / ss ssl index edatastacklist ptymin startrange endrange startpt endpt startpty endpty d ptymin gap startrangex startrangey endrangex endrangey xmin xmax ymin ymax vstacklist ydatastacklist edata arcdata edatalen verticeindex ycoordmin nowptforrad radindex ang degang oldptforrad ydata ydatastacklist ydatalen ydataindex plusgapstack plusgap edatastacklist edatastacklistlen edatastacklistindex editlineno gapy editent editverticecoord evcx evcy setcoord )
(princ "\n Select Vetical Polylines to arrange ")
(setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )




(setq ssl (sslength ss))
(setq index 0)
(setq edatastacklist nil)
(setq ptymin 0)
(setq startpty 0)
(setq endpty 0)

(setq startrange (getpoint "\n Set Start Range of vertices to Stretch "))
(setq endrange (getpoint "\n Set End Range of vertices to Stretch "))


(setq startpt (getpoint "\n Set Arrange X-axis Area 1st Point "))
(setq endpt (getpoint "\n Set Arrange X-axis Area 2nd Point "))
(setq startpty (car startpt))
(setq endpty (car endpt))
(setq d (abs (- startpty endpty )))
(setq ptymin (apply 'min (list startpty endpty)))

;(princ "\n ptymin")
;(princ ptymin)
(setq gap (/ d (+ ssl 1)))
;(princ "\n gap")
;(princ gap)

(setq ptymin (+ ptymin gap))
;(princ "\n ptymin")
;(princ ptymin)


(setq startrangex (car startrange))
(setq startrangey (cadr startrange))
(setq endrangex (car endrange))
(setq endrangey (cadr endrange))
(setq xmin (apply 'min (list startrangex endrangex)))
(setq xmax (apply 'max (list startrangex endrangex)))
(setq ymin (apply 'min (list startrangey endrangey)))
(setq ymax (apply 'max (list startrangey endrangey)))

;(princ (list xmin ymin))
;(princ (list xmax ymax))


(setq vstacklist nil)
(setq ydatastacklist nil)

;(setq ss2 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )


(repeat ssl

(setq edata (entget (ssname ss index)))
;(ssdel (ssname ss index) ss2)
(setq edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))

(setq edatalen (length edata))
(setq verticeindex 0)
(setq ycoordmin xmax)
;(setq ycoordcompare 0)
;(setq ystack nil)

  (repeat edatalen
    (setq vdata (list index verticeindex (nth verticeindex edata)))

    (if (and (and (<= (cadr (nth verticeindex edata)) xmax) (>= (cadr (nth verticeindex edata)) xmin)) (and (<= (caddr (nth verticeindex edata)) ymax) (>= (caddr (nth verticeindex edata)) ymin)))
       (progn (setq vstacklist (cons vdata vstacklist))) ;(setq ystack (cons ycoord ystack)))
    
    )
    (setq verticeindex (+ verticeindex 1))
  )



(setq nowptforrad (cdr (nth 0 edata)))
;(princ nowptforrad)
(setq radindex 1)
(setq ang 0)
(setq degang 0)
  (repeat (- edatalen 1)
     (setq oldptforrad nowptforrad)
     (setq nowptforrad (cdr (nth radindex edata)))
     ;(princ nowptforrad)
     (setq ang (angle (trans oldptforrad 1 0) (trans nowptforrad 1 0) ) )
     (setq degang (/ (* ang 180.0) pi))
     (if (and (or (and (<= degang 91) (>= degang 89)) (and (<= degang 271) (>= degang 269)) ) (and (<= (cadr (nth radindex edata)) xmax) (>= (cadr (nth radindex edata)) xmin)) (and (<= (caddr (nth radindex edata)) ymax) (>= (caddr (nth radindex edata)) ymin)))
        (setq ycoordmin (cadr (nth radindex edata)))
      
     )
     ;(princ "\n angle = ")
     ;(princ degang)
     ;(princ ycoordmin)
     (setq radindex (+ radindex 1))
  )
 



;(princ "\n ycoordmin ")
;(princ ycoordmin)
;(setq ycoordmin (car (LM:ListDupes ystack)))
(setq ydata (list ycoordmin index))
(setq ydatastacklist (cons ydata ydatastacklist))
(setq index (+ index 1))
)

;(princ ydatastacklist)
  (setq ydatastacklist (vl-sort ydatastacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )
;(princ "\n ydatastacklist")
;(princ ydatastacklist)


(setq ydatalen (length ydatastacklist))
(setq ydataindex 0)
(setq plusgapstack nil)
(repeat ydatalen
 (setq plusgap (list (cadr (nth ydataindex ydatastacklist)) (car (nth ydataindex ydatastacklist)) (- (car (nth ydataindex ydatastacklist)) ptymin) ))
 (setq plusgapstack (cons plusgap plusgapstack))
 (setq ydataindex (+ ydataindex 1))
 (setq ptymin (+ ptymin gap))
)
(setq plusgapstack (reverse plusgapstack))


  (setq plusgapstack (vl-sort plusgapstack
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ "\n plusgap")
;(princ plusgapstack)
(setq edatastacklist (reverse vstacklist))
;(princ "\n edatastack")
;(princ edatastacklist)

(setq edatastacklistlen (length edatastacklist))
(setq edatastacklistindex 0)

(repeat edatastacklistlen
  (setq editlineno (car (nth edatastacklistindex edatastacklist)))
  (setq gapy (caddr (nth editlineno plusgapstack)))
  ;(princ gapy)
  ;(princ editlineno)
  (setq editent (entget (ssname ss editlineno)))
  ;(princ editent)
  (setq editverticecoord (caddr (nth edatastacklistindex edatastacklist)))
  (setq evcx (cadr editverticecoord))
  (setq evcy (caddr editverticecoord))
  (setq evcx (- evcx gapy))
  (setq setcoord (cons 10 (list evcx evcy) ) )
  (setq editent (entmod (subst setcoord editverticecoord editent)))
;  (setq editent (entmod (subst '(10 0.0 0.0) editverticecoord editent)))
  (entupd (cdr (assoc -1 editent)))
  (setq edatastacklistindex (+ edatastacklistindex 1))
)

;;;today edited
;(setq ss2l (sslength ss2))
;(princ "\n ss2 length - ")
;(princ ss2l)

(setq plusgapl (length plusgapstack))
(setq pgindex 0)
(repeat plusgapl
 (setq plusgapy (cadr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapy - ")
 ;(princ plusgapy)
 (setq plusgapydelta (caddr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapydelta - ")
 ;(princ plusgapydelta)


 (setq ss3 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
 (setq index 0)
   (repeat ssl
      (ssdel (ssname ss index) ss3)
      (setq index (+ index 1))
   )
 (setq ss3l (sslength ss3))
;(princ "\n ss3 length - ")
;(princ ss3l)

 (setq ss3index 0)
   (repeat ss3l
     (setq ss3editent (entget (ssname ss3 ss3index)))
     (setq ss3edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss3editent))
     ;(princ "\n ss3edata filtered assoc 10 - ")
     ;(princ ss3edata)
     (setq ss3edatalen (length ss3edata))
     (setq ss3vindex 0)
        (repeat ss3edatalen
           (setq ss3vdata (list ss3index ss3vindex (nth ss3vindex ss3edata)))
           ;(princ "\n ss3vdata - ")
           ;(princ ss3vdata)
           (if (= plusgapy (cadr (nth ss3vindex ss3edata)))
              (progn 
                 (setq editverticecoord2 (nth ss3vindex ss3edata))
                 (setq evcx2 (cadr editverticecoord2))
                 (setq evcy2 (caddr editverticecoord2))
                 (setq evcx2 (- evcx2 plusgapydelta))
                 (setq setcoord2 (cons 10 (list evcx2 evcy2) ) )
                 (setq ss3editent (entmod (subst setcoord2 editverticecoord2 ss3editent)))
                 (entupd (cdr (assoc -1 ss3editent)))
              )
       
           )
           (setq ss3vindex (+ ss3vindex 1))
         )
     (setq ss3index (+ ss3index 1))
  )

 (setq pgindex (+ pgindex 1))
)
(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result - " (vl-princ-to-string ssl) " lines in " (vl-princ-to-string d) " space aligned with " (vl-princ-to-string gap) " spacing."))
(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)



(princ)
)







(defun c:ARRYVP ( / ss ssl index edatastacklist ptymin startrange endrange startpt endpt startpty endpty d ptymin gap startrangex startrangey endrangex endrangey xmin xmax ymin ymax vstacklist ydatastacklist edata arcdata edatalen verticeindex ycoordmin nowptforrad radindex ang degang oldptforrad ydata ydatastacklist ydatalen ydataindex plusgapstack plusgap edatastacklist edatastacklistlen edatastacklistindex editlineno gapy editent editverticecoord evcx evcy setcoord )
(princ "\n Select Horizontal Polylines to arrange ")
(setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )



(setq ssl (sslength ss))
(setq index 0)
(setq edatastacklist nil)
(setq ptymin 0)
(setq startpty 0)
(setq endpty 0)

(setq startrange (getpoint "\n Set Start Range of vertices to Stretch "))
(setq endrange (getpoint "\n Set End Range of vertices to Stretch "))


(setq startpt (getpoint "\n Set Arrange Y-axis Area 1st Point "))
(setq startpty (cadr startpt))

(setq ptymin startpty)
(setq gap (getreal "\n Input Gap "))
;(princ "\n gap")
;(princ gap)

(setq ptymin (+ ptymin gap))
;(princ "\n ptymin")
;(princ ptymin)


(setq startrangex (car startrange))
(setq startrangey (cadr startrange))
(setq endrangex (car endrange))
(setq endrangey (cadr endrange))
(setq xmin (apply 'min (list startrangex endrangex)))
(setq xmax (apply 'max (list startrangex endrangex)))
(setq ymin (apply 'min (list startrangey endrangey)))
(setq ymax (apply 'max (list startrangey endrangey)))

;(princ (list xmin ymin))
;(princ (list xmax ymax))


(setq vstacklist nil)
(setq ydatastacklist nil)

;(setq ss2 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )


(repeat ssl

(setq edata (entget (ssname ss index)))
;(ssdel (ssname ss index) ss2)
(setq edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))
(setq arcdata (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget (ssname ss index))))
;(princ "\n arcdata - ")
;(princ arcdata)
(setq edatalen (length edata))
(setq verticeindex 0)
(setq ycoordmin ymax)
;(setq ycoordcompare 0)
;(setq ystack nil)
  (repeat edatalen
    (setq vdata (list index verticeindex (nth verticeindex edata)))
    ;(setq ycoord (caddr (nth verticeindex edata)))
    (if (and (and (<= (cadr (nth verticeindex edata)) xmax) (>= (cadr (nth verticeindex edata)) xmin)) (and (<= (caddr (nth verticeindex edata)) ymax) (>= (caddr (nth verticeindex edata)) ymin)))
       (progn (setq vstacklist (cons vdata vstacklist))) ;(setq ystack (cons ycoord ystack)))
    
    )
    (setq verticeindex (+ verticeindex 1))
  )
(setq nowptforrad (cdr (nth 0 edata)))
;(princ nowptforrad)
(setq radindex 1)
(setq ang 0)
(setq degang 0)
  (repeat (- edatalen 1)
     (setq oldptforrad nowptforrad)
     (setq nowptforrad (cdr (nth radindex edata)))
     ;(princ nowptforrad)
     (setq ang (angle (trans oldptforrad 1 0) (trans nowptforrad 1 0) ) )
     (setq degang (/ (* ang 180.0) pi))
     (if (and (or (and (<= degang 1) (>= degang -1)) (and (<= degang 361) (>= degang 359)) (and (<= degang 181) (>= degang 179))) (and (<= (cadr (nth radindex edata)) xmax) (>= (cadr (nth radindex edata)) xmin)) (and (<= (caddr (nth radindex edata)) ymax) (>= (caddr (nth radindex edata)) ymin)))
        (setq ycoordmin (caddr (nth radindex edata)))
      
     )
     ;(princ "\n angle = ")
     ;(princ degang)
     ;(princ ycoordmin)
     (setq radindex (+ radindex 1))
  )
 



;(princ "\n ycoordmin ")
;(princ ycoordmin)
;(setq ycoordmin (car (LM:ListDupes ystack)))
(setq ydata (list ycoordmin index))
(setq ydatastacklist (cons ydata ydatastacklist))
(setq index (+ index 1))
)

;(princ ydatastacklist)
  (setq ydatastacklist (vl-sort ydatastacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )
;(princ "\n ydatastacklist")
;(princ ydatastacklist)


(setq ydatalen (length ydatastacklist))
(setq ydataindex 0)
(setq plusgapstack nil)
(repeat ydatalen
 (setq plusgap (list (cadr (nth ydataindex ydatastacklist)) (car (nth ydataindex ydatastacklist)) (- (car (nth ydataindex ydatastacklist)) ptymin) ))
 (setq plusgapstack (cons plusgap plusgapstack))
 (setq ydataindex (+ ydataindex 1))
 (setq ptymin (+ ptymin gap))
)
(setq plusgapstack (reverse plusgapstack))


  (setq plusgapstack (vl-sort plusgapstack
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ "\n plusgap")
;(princ plusgapstack)
(setq edatastacklist (reverse vstacklist))
;(princ "\n edatastack")
;(princ edatastacklist)

(setq edatastacklistlen (length edatastacklist))
(setq edatastacklistindex 0)

(repeat edatastacklistlen
  (setq editlineno (car (nth edatastacklistindex edatastacklist)))
  (setq gapy (caddr (nth editlineno plusgapstack)))
  ;(princ gapy)
  ;(princ editlineno)
  (setq editent (entget (ssname ss editlineno)))
  ;(princ editent)
  (setq editverticecoord (caddr (nth edatastacklistindex edatastacklist)))
  (setq evcx (cadr editverticecoord))
  (setq evcy (caddr editverticecoord))
  (setq evcy (- evcy gapy))
  (setq setcoord (cons 10 (list evcx evcy) ) )
  (setq editent (entmod (subst setcoord editverticecoord editent)))
;  (setq editent (entmod (subst '(10 0.0 0.0) editverticecoord editent)))
  (entupd (cdr (assoc -1 editent)))
  (setq edatastacklistindex (+ edatastacklistindex 1))
)

;;;today edited
;(setq ss2l (sslength ss2))
;(princ "\n ss2 length - ")
;(princ ss2l)

(setq plusgapl (length plusgapstack))
(setq pgindex 0)
(repeat plusgapl
 (setq plusgapy (cadr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapy - ")
 ;(princ plusgapy)
 (setq plusgapydelta (caddr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapydelta - ")
 ;(princ plusgapydelta)


 (setq ss3 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
 (setq index 0)
   (repeat ssl
      (ssdel (ssname ss index) ss3)
      (setq index (+ index 1))
   )
 (setq ss3l (sslength ss3))
;(princ "\n ss3 length - ")
;(princ ss3l)

 (setq ss3index 0)
   (repeat ss3l
     (setq ss3editent (entget (ssname ss3 ss3index)))
     (setq ss3edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss3editent))
     ;(princ "\n ss3edata filtered assoc 10 - ")
     ;(princ ss3edata)
     (setq ss3edatalen (length ss3edata))
     (setq ss3vindex 0)
        (repeat ss3edatalen
           (setq ss3vdata (list ss3index ss3vindex (nth ss3vindex ss3edata)))
           ;(princ "\n ss3vdata - ")
           ;(princ ss3vdata)
           (if (= plusgapy (caddr (nth ss3vindex ss3edata)))
              (progn 
                 (setq editverticecoord2 (nth ss3vindex ss3edata))
                 (setq evcx2 (cadr editverticecoord2))
                 (setq evcy2 (caddr editverticecoord2))
                 (setq evcy2 (- evcy2 plusgapydelta))
                 (setq setcoord2 (cons 10 (list evcx2 evcy2) ) )
                 (setq ss3editent (entmod (subst setcoord2 editverticecoord2 ss3editent)))
                 (entupd (cdr (assoc -1 ss3editent)))
              )
       
           )
           (setq ss3vindex (+ ss3vindex 1))
         )
     (setq ss3index (+ ss3index 1))
  )

 (setq pgindex (+ pgindex 1))
)
(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result : " (vl-princ-to-string ssl) " lines aligned from Y-coord " (vl-princ-to-string startpty) " with " (vl-princ-to-string gap) " spacing."))
(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)


(princ)
)



(defun c:ARRXVP ( / ss ssl index edatastacklist ptymin startrange endrange startpt endpt startpty endpty d ptymin gap startrangex startrangey endrangex endrangey xmin xmax ymin ymax vstacklist ydatastacklist edata arcdata edatalen verticeindex ycoordmin nowptforrad radindex ang degang oldptforrad ydata ydatastacklist ydatalen ydataindex plusgapstack plusgap edatastacklist edatastacklistlen edatastacklistindex editlineno gapy editent editverticecoord evcx evcy setcoord )
(princ "\n Select Vetical Polylines to arrange ")
(setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))

  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )


(setq ssl (sslength ss))
(setq index 0)
(setq edatastacklist nil)
(setq ptymin 0)
(setq startpty 0)
(setq endpty 0)

(setq startrange (getpoint "\n Set Start Range of vertices to Stretch "))
(setq endrange (getpoint "\n Set End Range of vertices to Stretch "))


(setq startpt (getpoint "\n Set Arrange X-axis Area 1st Point "))

(setq startpty (car startpt))


(setq ptymin startpty)


(setq gap (getreal "\n Input Gap "))

(setq ptymin (+ ptymin gap))



(setq startrangex (car startrange))
(setq startrangey (cadr startrange))
(setq endrangex (car endrange))
(setq endrangey (cadr endrange))
(setq xmin (apply 'min (list startrangex endrangex)))
(setq xmax (apply 'max (list startrangex endrangex)))
(setq ymin (apply 'min (list startrangey endrangey)))
(setq ymax (apply 'max (list startrangey endrangey)))

;(princ (list xmin ymin))
;(princ (list xmax ymax))


(setq vstacklist nil)
(setq ydatastacklist nil)

;(setq ss2 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )


(repeat ssl

(setq edata (entget (ssname ss index)))
;(ssdel (ssname ss index) ss2)
(setq edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))

(setq edatalen (length edata))
(setq verticeindex 0)
(setq ycoordmin xmax)
;(setq ycoordcompare 0)
;(setq ystack nil)

  (repeat edatalen
    (setq vdata (list index verticeindex (nth verticeindex edata)))

    (if (and (and (<= (cadr (nth verticeindex edata)) xmax) (>= (cadr (nth verticeindex edata)) xmin)) (and (<= (caddr (nth verticeindex edata)) ymax) (>= (caddr (nth verticeindex edata)) ymin)))
       (progn (setq vstacklist (cons vdata vstacklist))) ;(setq ystack (cons ycoord ystack)))
    
    )
    (setq verticeindex (+ verticeindex 1))
  )



(setq nowptforrad (cdr (nth 0 edata)))
;(princ nowptforrad)
(setq radindex 1)
(setq ang 0)
(setq degang 0)
  (repeat (- edatalen 1)
     (setq oldptforrad nowptforrad)
     (setq nowptforrad (cdr (nth radindex edata)))
     ;(princ nowptforrad)
     (setq ang (angle (trans oldptforrad 1 0) (trans nowptforrad 1 0) ) )
     (setq degang (/ (* ang 180.0) pi))
     (if (and (or (and (<= degang 91) (>= degang 89)) (and (<= degang 271) (>= degang 269)) ) (and (<= (cadr (nth radindex edata)) xmax) (>= (cadr (nth radindex edata)) xmin)) (and (<= (caddr (nth radindex edata)) ymax) (>= (caddr (nth radindex edata)) ymin)))
        (setq ycoordmin (cadr (nth radindex edata)))
      
     )
     ;(princ "\n angle = ")
     ;(princ degang)
     ;(princ ycoordmin)
     (setq radindex (+ radindex 1))
  )
 



;(princ "\n ycoordmin ")
;(princ ycoordmin)
;(setq ycoordmin (car (LM:ListDupes ystack)))
(setq ydata (list ycoordmin index))
(setq ydatastacklist (cons ydata ydatastacklist))
(setq index (+ index 1))
)

;(princ ydatastacklist)
  (setq ydatastacklist (vl-sort ydatastacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )
;(princ "\n ydatastacklist")
;(princ ydatastacklist)


(setq ydatalen (length ydatastacklist))
(setq ydataindex 0)
(setq plusgapstack nil)
(repeat ydatalen
 (setq plusgap (list (cadr (nth ydataindex ydatastacklist)) (car (nth ydataindex ydatastacklist)) (- (car (nth ydataindex ydatastacklist)) ptymin) ))
 (setq plusgapstack (cons plusgap plusgapstack))
 (setq ydataindex (+ ydataindex 1))
 (setq ptymin (+ ptymin gap))
)
(setq plusgapstack (reverse plusgapstack))


  (setq plusgapstack (vl-sort plusgapstack
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

;(princ "\n plusgap")
;(princ plusgapstack)
(setq edatastacklist (reverse vstacklist))
;(princ "\n edatastack")
;(princ edatastacklist)

(setq edatastacklistlen (length edatastacklist))
(setq edatastacklistindex 0)

(repeat edatastacklistlen
  (setq editlineno (car (nth edatastacklistindex edatastacklist)))
  (setq gapy (caddr (nth editlineno plusgapstack)))
  ;(princ gapy)
  ;(princ editlineno)
  (setq editent (entget (ssname ss editlineno)))
  ;(princ editent)
  (setq editverticecoord (caddr (nth edatastacklistindex edatastacklist)))
  (setq evcx (cadr editverticecoord))
  (setq evcy (caddr editverticecoord))
  (setq evcx (- evcx gapy))
  (setq setcoord (cons 10 (list evcx evcy) ) )
  (setq editent (entmod (subst setcoord editverticecoord editent)))
;  (setq editent (entmod (subst '(10 0.0 0.0) editverticecoord editent)))
  (entupd (cdr (assoc -1 editent)))
  (setq edatastacklistindex (+ edatastacklistindex 1))
)

;;;today edited
;(setq ss2l (sslength ss2))
;(princ "\n ss2 length - ")
;(princ ss2l)

(setq plusgapl (length plusgapstack))
(setq pgindex 0)
(repeat plusgapl
 (setq plusgapy (cadr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapy - ")
 ;(princ plusgapy)
 (setq plusgapydelta (caddr (nth pgindex plusgapstack)))
 ;(princ "\n plusgapydelta - ")
 ;(princ plusgapydelta)


 (setq ss3 (ssget "c" startrange endrange '((0 . "LWPOLYLINE")) ) )
 (setq ss3 (ssget "_P" (layerfilter 7)))
 (setq index 0)
   (repeat ssl
      (ssdel (ssname ss index) ss3)
      (setq index (+ index 1))
   )
 (setq ss3l (sslength ss3))
;(princ "\n ss3 length - ")
;(princ ss3l)

 (setq ss3index 0)
   (repeat ss3l
     (setq ss3editent (entget (ssname ss3 ss3index)))
     (setq ss3edata (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss3editent))
     ;(princ "\n ss3edata filtered assoc 10 - ")
     ;(princ ss3edata)
     (setq ss3edatalen (length ss3edata))
     (setq ss3vindex 0)
        (repeat ss3edatalen
           (setq ss3vdata (list ss3index ss3vindex (nth ss3vindex ss3edata)))
           ;(princ "\n ss3vdata - ")
           ;(princ ss3vdata)
           (if (= plusgapy (cadr (nth ss3vindex ss3edata)))
              (progn 
                 (setq editverticecoord2 (nth ss3vindex ss3edata))
                 (setq evcx2 (cadr editverticecoord2))
                 (setq evcy2 (caddr editverticecoord2))
                 (setq evcx2 (- evcx2 plusgapydelta))
                 (setq setcoord2 (cons 10 (list evcx2 evcy2) ) )
                 (setq ss3editent (entmod (subst setcoord2 editverticecoord2 ss3editent)))
                 (entupd (cdr (assoc -1 ss3editent)))
              )
       
           )
           (setq ss3vindex (+ ss3vindex 1))
         )
     (setq ss3index (+ ss3index 1))
  )

 (setq pgindex (+ pgindex 1))
)

(princ "\n Complete - Arrange the wires with a constant offset")
(princ (strcat "\n Result - " (vl-princ-to-string ssl) " lines aligned from X-coord " (vl-princ-to-string startpty) " with " (vl-princ-to-string gap) " spacing."))
(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)


(princ)
)




;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc_forrf 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc_forrf)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo_forrf doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

1235275246_2022-01-19101345.thumb.PNG.5187ee12f71ab1e1f7bdad97cc413bed.PNG

 

 

This is the lwpolyline version.

I studied a little, starting with extracting vertices for each polyline and output (line number-vertice number-assoc10 coordinates).

Now I know a little little bit about how to control polylines.

 

how to use

1. Select a polyline.

2. Select the vertices you want to stretch within the polyline. (by between 2 points)

3. Determine the y-axis area you want to arrange

 

 

There is a limitation

because the arc in the polyline can be modified as well.

In step number 2, you can edit multiple polylines at once, but only have one horizontal line per polyline.

 

 

+

edit - branch support.  (without fillet-end)

edit - ARRXP, ARRXVP, ARRYVP added

Edited by exceed

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...