Joining co-linear multilines together

[Jonathan Handojo]

Hi everyone,

 

This is my very first post in this forum, and I'm really scratching my head on this one.

 

Right here, I have a LISP routine that divides and break multilines into equal intervals of a specified length, with some threshold at the last segment. I'm not a professional programmer so please excuse my coding if it's unclear. I'm only interested in its layer, multiline scale, justification, and style. Thus, that's how I've coded my routine. 

 

Also, I'm only interested on multilines that only has 2 vertices , since they're straight. Thus, I've coded it as such that the code won't proceed unless all mlines in the selection set only has two vertices. Below is the code I've used and running "DIVML" in the command line will divide each multiline into equal intervals:

 

(defun pt_intervals (p1 p2 len threshold)	; Returns a list points between p1 and p2 at intervals of 'len' with a given 'threshold' at the last segment.
  (cond						; It simply means that the last segment should have a minimum length of the given 'threshold'
    ((< (distance p1 p2) (+ len threshold)) (list p2))
    ((>= (distance p1 p2) len)
     (cons (polar p1 (angle p1 p2) len)
	  (pt_intervals (polar p1 (angle p1 p2) len) p2 len threshold)))
    )
  )

(defun list-x-to-y (l x y)			; Returns a list between indices x and y inclusive
  (cond
    ((or (null l) (minusp y)) nil)
    ((zerop x) (cons (car l) (list-x-to-y (cdr l) x (1- y))))
    (T (list-x-to-y (cdr l) (1- x)(1- y)))
    )
  )

(defun c:divml ( / *error* acadobj mlines mliter no_vertices len threshold)
  (defun *error* (msg)
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
      )
    )
  (setq acadobj (vlax-get-acad-object)
	adoc (vla-get-ActiveDocument acadobj)
	msp (vla-get-ModelSpace adoc))
  (vla-StartUndoMark adoc)
  (while
    (progn
      (setq mlines (ssget '((0 . "MLINE"))))
      (cond
	((not mlines) (princ "\nPlease select at least one multiline"))
	((progn
	   (setq mliter 0
		 no_vertices nil)
	   (while (< mliter (sslength mlines))
	     (setq no_vertices (cons
				 (vlax-safearray-get-u-bound
				   (vlax-variant-value
				     (vla-get-Coordinates
				       (vlax-ename->vla-object (ssname mlines mliter)))) 1) no_vertices)
		   mliter (1+ mliter)
		   )
	     )
	   (not (and (= (car no_vertices) 5) (apply '= no_vertices)))
	   )
	 (princ "\nPlease select multilines containing only two vertices")
	 )
	)
      )
    )
  
  (while
    (progn
      (setq len (getreal "\nSpecify interval length: "))
      (cond
	((not len) (princ "\nExpects a positive integer or real value"))
	((minusp len) (princ "\nExpects a positive value"))
	)
      )
    )
  
  (while
    (progn
      (setq threshold (getreal "\nSpecify threshold at end segment or <0>: "))
      (cond
	((not threshold) (setq threshold 0) nil)
	((minusp threshold) (princ "\nExpects a positive value"))
	)
      )
    )

  (divml mlines len threshold)
  (vla-EndUndoMark adoc)
  (princ)
  )

(defun divml (ss len threshold / iter in_list vi mjust mscale mlayer mstyle 1ml divisions strpt endpt starts ends mls)
  (setq iter 0
	cmlstyle (getvar "cmlstyle"))
  (while (< iter (sslength ss))
    (setq in_list (cons (ssname ss iter) in_list)
	  iter (1+ iter))
    )
  (foreach i in_list
    (setq vi (vlax-ename->vla-object i)
	  mjust (vla-get-Justification vi)
	  mscale (vla-get-MlineScale vi)
	  mlayer (vla-get-layer vi)
	  mstyle (vla-get-StyleName vi)
	  strpt (list-x-to-y
		  (setq 1ml (vlax-safearray->list
			      (vlax-variant-value
				(vla-get-coordinates vi)))) 0 2)
	  endpt (list-x-to-y 1ml 3 5)
	  divisions (append (list strpt) (setq ends (pt_intervals strpt endpt len threshold)))
	  starts (list-x-to-y divisions 0 (- (length divisions) 2)))
    (setvar "cmlstyle" mstyle)
    (setq mls (mapcar '(lambda (x y / mvertices)
			 (setq mvertices (vlax-make-safearray vlax-vbDouble (cons 0 (1- (+ (length x) (length y))))))
			 (vlax-safearray-fill mvertices (append x y))
			 (vla-AddMline msp mvertices))
		      starts ends))
    (foreach j mls
      (vla-put-layer j mlayer)
      (vla-put-Justification j mjust)
      (vla-put-Mlinescale j mscale)
      )
    (entdel i)
    )
  )

My question is... after running this routine, how can I join those same multilines to the way it was before? (After breaking the multilines, I won't be making any adjustments to the multilines. I'm only breaking them for a short while for other uses with my other LISP routines, but then I want to join them back.)

 

Thanks,

Jonathan Handojo

[hanhphuc]

hi in your sub divml snippet

 

;;;    (setq mls (mapcar '(lambda (x y / mvertices)
;;;			 (setq mvertices (vlax-make-safearray vlax-vbDouble (cons 0 (1- (+ (length x) (length y))))))
;;;			 (vlax-safearray-fill mvertices (append x y))
;;;			 (vla-AddMline msp mvertices))
;;;		      starts ends))

with this

 
    (setq lst       (apply 'append divisions)
          mvertices (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length lst))))
          )
    (vlax-safearray-fill mvertices lst)
    (setq mls (vla-AddMline msp mvertices))

 

 

FWIW

while loop can be shorten with 

1.ssget filter

2.initget 

 

(defun c:divml ( / *error* acadobj mlines mliter no_vertices len threshold)

;; <... snippet ...>
;; ....
  
  (vla-StartUndoMark adoc)
  (and (setq mlines (ssget ":L" '((0 . "MLINE") (72 . 2))))
       (not (initget 7))
       (setq len (getdist "\nSpecify interval length: "))
       (progn (initget 5) (setq threshold (getdist "\nSpecify threshold at end segment or <0>: ")))
   (divml mlines len threshold))
  (vla-EndUndoMark adoc)
  (princ)
  )

 

Edited November 11, 2019 by hanhphuc

[Jonathan Handojo]

I forgot to mention... Sorry for my poor explanation, but I need those mlines literally divided into individual mlines, as I will be using other LISP routines to gather data from those Mlines. 

 

What I wrote works, and what you wrote works too. But what I'm after is to reverse that process... (Like, bring back what I've divided back to one, like joining those Mlines back together).

 

Thanks,

Jonathan Handojo

Edited November 12, 2019 by Jonathan Handojo

[hanhphuc]

23 hours ago, Jonathan Handojo said:

 

My question is... after running this routine, how can I join those same multilines to the way it was before? (After breaking the multilines, I won't be making any adjustments to the multilines. I'm only breaking them for a short while for other uses with my other LISP routines, but then I want to join them back.)

 

 

Hi just to clarify, why not just using command "UNDO" ? unless i'm missing something ?

 

8 hours ago, Jonathan Handojo said:

I forgot to mention... Sorry for my poor explanation, but I need those mlines literally divided into individual mlines, as I will be using other LISP routines to gather data from those Mlines. 

 

What I wrote works, and what you wrote works too. But what I'm after is to reverse that process... (Like, bring back what I've divided back to one, like joining those Mlines back together).

 

Thanks,

Jonathan Handojo

 

suggestion

1. If you only need data, in your sub routine cons data in list for each loop, not necessary to create new objects. i.e: There's no need to entdel the original Mline , just retain it highlight (redraw i 3) or hide with (redraw i 4)

2. But if you insist to create these divided mlines, just erase these individual mlines after 'your other LISP routines' complete

3. use ssadd in divml