Topic: Add vertex mline

[Lupo76]

Unfortunately, the MLINE entities capabilities in BricsCAD are limited compared AutoCAD.
Is there a lisp to add or remove a vertex of a multi-line?

[roy_043]

Have you tried (vlax-put obj 'coordinates ...)?

[Lupo76]

I studied a little 'code  (vlax-put obj 'coordinates ...)
However there is much work to do to achieve the result as if, for example, a multi-line has 4 vertices I find 8 point coordinates and then I am forced to find the 2 vertex coordinates perpendicular to each other.

I should be able to do this but there is much work to do.
Before doing this I would like to dedicate some of my time to see if there is something ready 

[Lupo76]

Perhaps the code is not very clean, but I managed to achieve the result

Code: [Select]

(defun c:AddVertexMLine (/ listavertex new_CoordList ogg Pt Obj CoordList n X Y listavertex dist tmpPt1 tmpPt2 tmpPer Pper Ang)
;*************************************
   (setvar "CMDECHO" 0)
   (setq old-error *error*)
   (defun *error* (msg)
     (setq messaggio (strcat "Errore: " msg))
     (princ messaggio)
     (setq *error* old-error)
     (command "_.undo" "_end" "_u")
     (exit)
   )
   (command "_.undo" "_be")
   (setq var (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
;*************************************

  (setq ogg (car (entsel "\nSelect mline: ")))
  (if (/= ogg nil)
    (if (= (cdr (assoc 0 (entget ogg))) "MLINE")
      (progn
        (while (= Pt nil)(setq Pt (getpoint "\nSelect point: ")))
        (setq Obj (vlax-ename->vla-object ogg))
        (setq CoordList (vlax-get Obj 'Coordinates))
       
        ;----
        (setq n 0)
        (while (< n (length CoordList))
          (progn
            (setq X (nth n CoordList))
            (setq Y (nth (+ n 1) CoordList))
            (if listavertex
              (setq listavertex (append (list (list X Y)) listavertex))
              (setq listavertex (list (list X Y)))
            )
            (setq n (+ n 3))
          )
        )
        ;----
       
        ;----
        (setq n 0)
        (setq dist nil)
        (while (< (+ n 1)(length listavertex))
          (progn
            (setq tmpPt1 (nth n listavertex))
            (setq tmpPt2 (nth (+ n 1) listavertex))
            (setq tmpPer (inters tmpPt1 tmpPt2 (polar pt (- (angle tmpPt1 tmpPt2)(* pi 0.5)) (distance pt tmpPt1)) (polar pt (+ (angle tmpPt1 tmpPt2)(* pi 0.5)) (distance pt tmpPt1)) T))
            (if (/= tmpPer nil)
              (if (= dist nil)
                (progn
                  (setq dist (distance tmpPer Pt))
                  (setq Pper tmpPt1)
                )
                (if (< (distance tmpPer Pt) dist)
                  (progn
                    (setq dist (distance tmpPer Pt))
                    (setq Pper tmpPt1)
                  )
                )
              )
            )
            (setq n (+ n 1))
          )
        )
        ;----

        ;----
        (setq n 0)
        (while (< (+ n 1)(length listavertex))
          (progn
            (setq tmpPt1 (nth n listavertex))
            (setq tmpPt2 (nth (+ n 1) listavertex))
            (setq Ang (angle tmpPt1 tmpPt2))
           
            ;--
            (if new_CoordList
              (setq new_CoordList (append (list 0.0) new_CoordList))
              (setq new_CoordList (list 0.0))
            )
            (setq new_CoordList (append tmpPt1 new_CoordList))
            (if
              (or
                (equal (angle Pper tmpPt1) Ang 0.000001)
                (equal (angle Pper tmpPt2) Ang 0.000001)
              )
              (progn
                (setq new_CoordList (append Pt new_CoordList))
              )
            )
            ;--
            (setq n (+ n 1))
          )
        )
        (setq new_CoordList (append (list 0.0) new_CoordList))
        (setq new_CoordList (append tmpPt2 new_CoordList))
       
        ;----

        (vlax-put Obj 'Coordinates new_CoordList)
      )
    )
  )
 
;*************************************
  (setq *error* old-error)
  (command "_.undo" "_end")
  (setvar "cmdecho" var)
  (princ)
)


[roy_043]

Here is how I would do it:

Code - Auto/Visual Lisp: [Select]

1. (defun KGA_List_Divide_3 (lst / ret)
2.   (repeat (/ (length lst) 3)
3.     (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
4.     (setq lst (cdddr lst))
5.   )
6.   (reverse ret)
7. )
8.  
9. (defun KGA_List_IndexSeqMakeLength (len / ret)
10.   (repeat (rem len 4)
11.     (setq ret (cons (setq len (1- len)) ret))
12.   )
13.   (repeat (/ len 4)
14.     (setq ret
15.       (vl-list*
16.         (- len 4)
17.         (- len 3)
18.         (- len 2)
19.         (- len 1)
20.         ret
21.       )
22.     )
23.     (setq len (- len 4))
24.   )
25.   ret
26. )
27.  
28. ; (MlineVertexAdd (vlax-ename->vla-object (car (entsel))) (trans (getpoint "\nNew point: ") 1 0) nil)
29. ; The point pt is automatically translated: WCS -> OCS -> Correct Z in OCS -> WCS.
30. (defun MlineVertexAdd (obj pt idx / coordLst) ; Pt in WCS. Idx >= 0 or nil.
31.   (setq coordLst (vlax-get obj 'coordinates))
32.   (vlax-put
33.     obj
34.     'coordinates
35.     (if (or (not idx) (>= idx (/ (length coordLst) 3)))
36.       (append coordLst pt)
37.       (apply
38.         'append
39.         (mapcar
40.           '(lambda (i p)
41.             (if (= i idx)
42.               (append pt p)
43.               p
44.             )
45.           )
46.           (KGA_List_IndexSeqMakeLength (/ (length coordLst) 3))
47.           (KGA_List_Divide coordLst 3)
48.         )
49.       )
50.     )
51.   )
52.   obj
53. )