multi-polyline

[pkenewell]

On 5/28/2021 at 12:51 AM, masterfal said:

oh thats awesome.. thankyou so much! one last thing, is it possible to set the desired linetype scale to always be 20? because thats what i will be inputting at that prompt everytime i use it so if it could somehow be pre-specified that would skip a step and then it'd be perfect

 

@masterfal OK - simple enough - I just hardcoded the value to be 20 and commented out the lines for prompting.

 

NOTE: If you want - in the future - to prompt for the value again, the code is still in there - you just remove the semi-colons in front of lines 46-51.

MPlineV1-1_PJK.lsp

[3dwannab]

Here's my edit of Lee Mac's program. I always want to change the justification and, more often than not, the scale.

 

It's a pity the command doesn't give you the option to change the justification on the fly when you pick the first point.

 

See the changes in the header below.

 

;;------------------------=={ Multi-Polyline  }==-----------------------;;
;;                                                                      ;;
;;  This program enables the user to create objects with the appearance ;;
;;  of multilines, however, which are composed of standard polylines.   ;;
;;                                                                      ;;
;;  The program will invoke the standard AutoCAD MLINE command,         ;;
;;  allowing the user to construct the object with the real-time        ;;
;;  dynamic preview afforded by the MLINE command, with the resulting   ;;
;;  multiline automatically exploded & joined to form standard 2D       ;;
;;  polylines.                                                          ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright ? 2010  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2010-06-19                                      ;;
;;                                                                      ;;
;;  First release.                                                      ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2015-09-12                                      ;;
;;                                                                      ;;
;;  Program rewritten.                                                  ;;
;;----------------------------------------------------------------------;;

;; Revision by 3dwannab 2023.01.24
;;  - Added - Changing the linetype of the mline to bylayer.
;;  - Added - Selects the new polyline after its creation.
;;  - Added - A scale prompt and the mline justification prompt before every mline. Value of ml scale is saved to the registry so it'll be remembered throughout your different ACAD sessions.

;; Revision by 3dwannab 2024.10.24
;;  - Fixed - My code to select the new polylines. Didn't select all polylines when the mline was a closed one.

(defun c:ml (/ *error* ent obj regValMLScale ss1 ss2 ssnew val var var_osmode) 

  (defun *error* (msg) 
    (mapcar 'setvar var val)

    (setvar 'osmode var_osmode)

    (LM:endundo (LM:acdoc))
    (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) 
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (setq var_osmode (getvar "osmode"))

  (LM:startundo (LM:acdoc))
  (setq ent (entlast))

  ;; Get saved round off value from the registry or default to 1
  (setq regValMLScale (cond ((getenv "MPlineMLScaleValue")) (1)))

  ;; Prompt for integer value to round off to
  (setq regValMLScale (cond 
                        ((getint 
                           (strcat "\nWhat Scale do you want the polyline? <" 
                                   (vl-princ-to-string regValMLScale)
                                   ">: "
                           )
                         )
                        )
                        (regValMLScale)
                      )
  )
  ;; Set the registry value to the variable
  (setenv "MPlineMLScaleValue" (vl-princ-to-string regValMLScale))

  ;; Get new selection set of polylines after join operation
  (setq ssnew (ssget "X" '((0 . "LWPOLYLINE")))) ; Get all polylines again

  (vl-cmdf "_.mline" "s" regValMLScale "j")
  (while (= 1 (logand 1 (getvar 'cmdactive))) 
    (vl-cmdf "\\")
  )
  (if (not (eq ent (setq ent (entlast)))) 
    (progn 
      (setq var '(cmdecho peditaccept qaflags)
            val (mapcar 'getvar var)
            ss1 (ssadd)
      )
      (mapcar 'setvar var '(0 1 0))
      (vl-cmdf "_.explode" ent "")
      (while (setq ent (entnext ent)) (ssadd ent ss1))

      ;; Get a list of entities before the join operation
      (setq ss2 (ssget "X" '((0 . "LWPOLYLINE")))) ; Get all existing polylines

      (vl-cmdf "_.chprop" ss1 "" "_lt" "_bylayer" "")

      ;; Perform join operation on selected objects
      (vl-cmdf "_.pedit" "_m" ss1 "" "_j" "" "")

      ;; Get new selection set of polylines after join operation
      (setq ssnew (ssget "X" '((0 . "LWPOLYLINE")))) ; Get all polylines again

      ;; Compare and find the new polylines created by the join command
      (setq obj nil) ; Initialize a list for newly created polylines
      (if ssnew 
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssnew))) 
          (if (not (ssmemb ent ss2))  ; If the entity wasn't in the old set
            (setq obj (cons ent obj)) ; Add the entity to the new polyline list
          )
        )
      )

      ;; Highlight the new polylines
      (if obj 
        (progn 
          (setq ssnew (ssadd)) ; Create a new selection set
          (foreach ent obj 
            (ssadd ent ssnew) ; Add each new polyline to the selection set
          )
          (sssetfirst nil ssnew) ; Highlight the new polylines
          (princ " \nMuliline created")
          (command "_.regen")
        )
        (princ " \nNo Muliline created")
      )
    )
  )

  (*error* nil)
  (princ)
)

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

(defun LM:startundo (doc) 
  (LM:endundo 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)
  )
)

;; 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)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

; (c:ml) ;; Unblock for testing

 

Edited October 24 by 3dwannab
Fixed - My code to select the new polylines. Didn't select all polylines when the mline was a closed one.