Jump to content

Recommended Posts

Posted

It would be great if someone can help me :) !

 

I need to break several polylines with different widths in each segment. If I explode them, I'll loose the widths, having just lines as a result. I'd like to separate each segment in the vertices. Is it possible with a lisp routine?

 

I couldn't find anything like that. I have a very little knowledge about lisp routines. I can build simple ones and I believe this one is not so simple, if it's possible, of course :wink:..

 

Thanks a lot!

Posted

Couldn't sleep... not a whole lot of testing.

See if this works for you

;;; Break pline @ vertices LPS 2010-04-01
(defun c:test (/ idx obj endparam ptlst)
(vl-load-com)
(setq temperr *error*)            
(setq *error* errortrap)
(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) )
 (if ; test if polyline
   (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
      (princ "\nSelected entity is not a polyline")
   )
 (setq ptlst (list (vlax-curve-getStartPoint obj))
   idx 1)
 (if (zerop (vlax-get obj 'Closed))
       (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
   (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
   )
  (while
   (<= idx endparam)
     (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
    idx (1+ idx)
    )
  )
 (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst)
  (princ)
 );defun

(defun errortrap (msg)
  (if (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n<< Error: " msg " >>")))
 (setq *error* temperr)
(princ)
)

errortrap isn't working properly... oh well

Posted
Couldn't sleep... not a whole lot of testing.

See if this works for you

;;; Break pline @ vertices LPS 2010-04-01
(defun c:test (/ idx obj endparam ptlst)
(vl-load-com)
(setq temperr *error*)            
(setq *error* errortrap)
(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) )
 (if ; test if polyline
   (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
      (princ "\nSelected entity is not a polyline")
   )
 (setq ptlst (list (vlax-curve-getStartPoint obj))
   idx 1)
 (if (zerop (vlax-get obj 'Closed))
       (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
   (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
   )
  (while
   (<= idx endparam)
     (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
    idx (1+ idx)
    )
  )
 (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst)
  (princ)
 );defun

(defun errortrap (msg)
  (setq *error* temperr)
 (if (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n<< Error: " msg " >>"))
 ;
(princ)
)

errortrap isn't working properly... oh well

 

 

 

 

Wow, lpseifert! It worked perfectly!

What do you mean by "errortrap isn't working properly"!

I tested in a pline with 5 segments, with different widths, and voilá! Five independent polylines, carrying their own width! That's perfect! Thanks so much, and just in time! I was shutting down the computer for holidays!

Have a nice Easter!

Thanks!

You can sleep now :sleeping:... :D!

 

LGB

  • 9 years later...
Posted

Hi there,

 

Thanks for this LSP.

 

I wanted to break the polyline at certain vertex point. Is that possible?

 

Ex: i have a polyline with 30 vertexes

 

I want o break the line at 22nd vertex only

Posted

Will the Break command not work? You can select the polyline, use F to specify the vertex (First point) at which to begin the break, and use @ to end at the same point. I believe there's a predefined button for this variant of Break.

Posted (edited)

Try this. You have to select the polyline close to the vertex where you want to break it.

 

(defun c:bav ( / *error* c_doc sv_lst sv_vals sel ent pt v_pt v_p r e_p s_p)
  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
	
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (while (setq sel (entsel "\nSelect vertex to Break Polyline At : "))
    (setq ent (car sel)
          pt (cadr sel)
          v_pt (vlax-curve-getclosestpointto ent pt)
          v_p (vlax-curve-getparamatpoint ent v_pt)
          r (rem v_p 1.0)          
    );end_setq
    (cond ( (>= r 0.5) (setq v_pt (vlax-curve-getpointatparam ent (setq v_p (float (1+ (fix v_p)))))))
          (t (setq v_pt (vlax-curve-getpointatparam ent (setq v_p (float (fix v_p))))))
    );end_cond      
    (cond ( (= (- (setq e_p (vlax-curve-getendparam ent)) (setq s_p (vlax-curve-getstartparam ent))) 1.0) (alert "Polyline has NO vertices, Only has Ends"))
          ( (or (= v_p s_p) (= v_p e_p)) (alert "Nearest Vertex is an End Point"))
          (t (vl-cmdf "break" ent "_F" v_pt v_pt))
    );end_cond      
  );end_while
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun
  

 

Edited by dlanorh
  • 4 years later...
Posted
(defun c:foo (/ i n idx obj endparam ptlst ent en)
    (vl-load-com)

    (princ "\nSelect polylines to break: ")

    (if (setq ss (ssget  '((0 . "LINE,*POLYLINE") (8 . "*LayerTest*"))))
        (progn
            (princ "\nIts working...")
            (setq i 0)
            (setq n (sslength ss))
            (while (< i n)
                (setq ent (ssname ss i)
                    en (cdr (assoc 0 (entget ent)))
                    i (1+ i)
                )

                (if (member en (list "POLYLINE" "LWPOLYLINE"))
                    (progn

                        (setq obj (vlax-ename->vla-object ent))
                        (if ; test if polyline
                            (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
                            (princ "\nSelected entity is not a polyline")
                        )

                        (if (zerop (vlax-get obj 'Closed))
                            (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
                            (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
                        )

                        (setq idx 0)
                        (while (<= idx endparam)
                            (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
                                  idx (1+ idx)
                            )
                            (princ idx)

                        )
                        (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst)

                    )
                )
            )
        )
        (princ "\nTry again and please select polylines")
    )

    (princ)
);defun

 

 

I am trying to use the lisp in this post above to break all Polylines in the multi selection...  I attempted to make the change but I'm getting an error.. My guess the issue in the ent variable. 

Posted

OK let me guess the error... or you could help us out, what is the error you are getting, what happens, is there an error message in the command line, does the LISP not do anything, does it do something but the wrong thing, have you worked out where the LISP stops working? I see you have a princ "It's Working" but what about after then?

Posted

(the polyline needs to be in  "LayerTest"  layer for it to work.

 

I believe the issue is in the ent variable. (Original has the ent name and selection point while the mine only has the ent name)

 

The error occurs in the function... As "invalid point" during the break action.

 

in the original code "(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) )"

then ent  variable contains the following = (<Entity name: 1d2f9876980> (16.1305 12.6584 0.0))

while in my version  "(setq ent (ssname ss i))"  the ent variable contains the following =  <Entity name: 1d2f9876980>

Posted

Had a quick look and since it is the weekend the CAD is (mostly) off... so not tested this fully

 

(break "F" Entity point point)

 

If you use (entsel) to select the entity the selection is the entity name + the point you clicked: (<Entity name: 1fbee697c90> (2888.04 1196.85 0.0))

If you use (ssget) the individual entities from (ssname) are just the entity name (<Entity name: 1fbee697c90>)

... so if only there was a way to create a list from the ssget entity name + a point......

 

I reckon - and without going through the rest of the code, do something like this:

 

(defun c:test ( / MySS n MyEnt MyPt )
  (setq MySS (ssget))                                   ;;Selection set, add filters as you like
  (setq n 0)                                            ;;A counter for the loop
  (while (< n (sslength MySS))                          ;;Start loop
    (setq MyEnt (ssname MySS n))                        ;;nth entity in selection set
    (setq MyPt (getpoint "\nSelect first break point")) ;;Specify the break point. Check if it is on the entity?
    (setq MyEnt (list MyEnt MyPt) )                     ;;Add point to selected entity
    (command "Break" MyEnt "F" MyPT pause)              ;;Break entity
    (setq n (+ n 1))                                    ;;increase loop counter
  ) ; end while                                         ;;end loop
  (princ)                                               ;;end quietly
)

 

 

Posted (edited)

can be put together something like this: 

 

(defun c:test ( / MySS n MyEnt MyFullEnt PtLst PtCount MyPt )
  (defun mAssoc ( key lst / result ) ; returns a list of 'key' from an associated list
  ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x)) (setq result (cons (cdr x) result)) )
    ) ; end foreach
   (reverse result)
  ) ; end defun

  (setq MySS (ssget '((0 . "*POLYLINE")(8 . "*LayerTest*") )) ) ;;Selection set, add filters as you like
  (setq n 0)                                            ;;A counter for the loop
  (while (< n (sslength MySS))                          ;;Start loop
    (setq MyEnt (ssname MySS n))                        ;;nth entity in selection set
    (setq PtLst (reverse (mAssoc 10 (entget MyEnt))))   ;;get coordinates
    (setq PtCount 1)                                    ;;Another counter
    (if (= (cdr (assoc 70 (entget MyEnt))) 1)(setq PtCount 0)) ;;Counter to 0 if closed polyline
    (while (< (+ PtCount 1) (length PtLst))             ;;Loop the coordinates
      (setq MyPt (nth PtCount PtLst))                   ;;nth coordinate
      (setq MyFullEnt (list MyEnt MyPt) )               ;;Add point to selected entity
      (command "Break" MyFullEnt "F" MyPT MyPt)         ;;Break entity
      (setq PtCount (+ PtCount 1))                      ;;increase counter
    ) ; end while                                       ;;end loop
    (setq n (+ n 1))                                    ;;increase loop counter
  ) ; end while                                         ;;end loop
  (princ)                                               ;;end quietly
)

 

Edited by Steven P
Posted

This :

(if (= (cdr (assoc 70 (entget MyEnt))) 1)(setq PtCount 0)) ;;Counter to 0 if closed polyline

 

Should be :

(if (= 1 (logand 1 (cdr (assoc 70 (entget MyEnt))))) (setq PtCount 0)) ;;Counter to 0 if closed polyline

  • Like 1
Posted

Yup, suppose it should be logand, though I usually find it works without it. Thanks

Posted (edited)
2 hours ago, Steven P said:

Yup, suppose it should be logand, though I usually find it works without it. Thanks

 

If user activated plinegen = 1, then DXF 70 becomes 128 (plinegen)+1 (closed) = 129, so (logand) is the only right way to code it...

(not to mention 3dpolylines DXF 70 = 8,9 , old heavy polylines with different type of fittings (quadratic, qubic)...)

Edited by marko_ribar
Posted

@DavidP

Quote

 I am trying to use the lisp in this post above to break all Polylines in the multi selection...

I can offer you another version to do what you want.
If you also use Map3D or Civil3D with object data, this data is preserved for each cut segment.

(defun c:break_lw@vtx_withOD ( / js i ent dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef )
  (initget "All Select")
  (if (eq (getkword "\nLWPolyline(s) to break at each vertex? [All/Select] <Select>: ") "All")
    (setq
      js
        (ssget "_X" 
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      i -1
    )
    (setq
      js
        (ssget
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      i -1
    )
  )
  (cond
    (js
      (repeat (sslength js)
        (setq
          dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))) (list "*"))
          xd_l (assoc -3 dxf_obj)
        )
        (if (cdr (assoc 43 dxf_obj))
          (setq dxf_43 (cdr (assoc 43 dxf_obj)))
          (setq dxf_43 0.0)
        )
        (if (cdr (assoc 38 dxf_obj))
          (setq dxf_38 (cdr (assoc 38 dxf_obj)))
          (setq dxf_38 0.0)
        )
        (if (cdr (assoc 39 dxf_obj))
          (setq dxf_39 (cdr (assoc 39 dxf_obj)))
          (setq dxf_39 0.0)
        )
        (setq
          dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
          dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
          dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
          dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
          dxf_210 (cdr (assoc 210 dxf_obj))
        )
        (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
          (setq
            dxf_10 (append dxf_10 (list (car dxf_10)))
            dxf_40 (append dxf_40 (list (car dxf_40)))
            dxf_41 (append dxf_41 (list (car dxf_41)))
            dxf_42 (append dxf_42 (list (car dxf_42)))
            n (cdr (assoc 90 dxf_obj))
          )
          (setq n (1- (cdr (assoc 90 dxf_obj))))
        )
        (repeat n
          (entmake
            (append
              (list
                (cons 0 "LWPOLYLINE")
                (cons 100 "AcDbEntity")
                (assoc 67 dxf_obj)
                (assoc 410 dxf_obj)
                (assoc 8 dxf_obj)
                (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
                (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
                (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
                (cons 100 "AcDbPolyline")
                (cons 90 2)
                (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
                (cons 38 dxf_38)
                (cons 39 dxf_39)
                (cons 10 (car dxf_10))
                (cons 40 (car dxf_40))
                (cons 41 (car dxf_41))
                (cons 42 (car dxf_42))
                (cons 10 (cadr dxf_10))
                (cons 40 (cadr dxf_40))
                (cons 41 (cadr dxf_41))
                (cons 42 (cadr dxf_42))
                (assoc 210 dxf_obj)
              )
              (if xd_l (list xd_l) '())
            )
          )
          (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast))
          (if
            (or
              (numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
              (numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
            )
            (progn
              (foreach n (ade_odgettables ent)
                (setq tbldef (ade_odtabledefn n))
                (setq lst_data
                  (cons
                    (mapcar
                      '(lambda (fld / tmp_rec numrec)
                        (setq numrec (ade_odrecordqty ent n))
                        (cons
                          n
                          (while (not (zerop numrec))
                            (setq numrec (1- numrec))
                            (if (zerop numrec)
                              (if tmp_rec
                                (cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                                (cons fld (ade_odgetfield ent n fld numrec))
                              )
                              (setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                            )
                          )
                        )
                      )
                      (mapcar 'cdar (cdaddr tbldef))
                    )
                    lst_data
                  )
                )
              )
              (cond
                (lst_data
                  (mapcar
                    '(lambda (x / ct)
                      (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                        (ade_odaddrecord nwent (caar x))
                      )
                      (foreach el (mapcar 'cdr x)
                        (if (listp (cdr el))
                          (progn
                            (setq ct -1)
                            (mapcar
                              '(lambda (y / )
                                (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                              )
                              (cadr el)
                            )
                          )
                          (ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                        )
                      )
                    )
                    lst_data
                  )
                )
              )
            )
          )
        )
        (entdel ent)
      )
      (print (sslength js)) (princ " LWpolyline(s) breaked at its vertices with its Object Datas.")
    )
  )
  (prin1)
)

 

  • Like 1
Posted
On 11/25/2023 at 3:54 PM, Steven P said:

can be put together something like this: 

 

(defun c:test ( / MySS n MyEnt MyFullEnt PtLst PtCount MyPt )
  (defun mAssoc ( key lst / result ) ; returns a list of 'key' from an associated list
  ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x)) (setq result (cons (cdr x) result)) )
    ) ; end foreach
   (reverse result)
  ) ; end defun

  (setq MySS (ssget '((0 . "*POLYLINE")(8 . "*LayerTest*") )) ) ;;Selection set, add filters as you like
  (setq n 0)                                            ;;A counter for the loop
  (while (< n (sslength MySS))                          ;;Start loop
    (setq MyEnt (ssname MySS n))                        ;;nth entity in selection set
    (setq PtLst (reverse (mAssoc 10 (entget MyEnt))))   ;;get coordinates
    (setq PtCount 1)                                    ;;Another counter
    (if (= (cdr (assoc 70 (entget MyEnt))) 1)(setq PtCount 0)) ;;Counter to 0 if closed polyline
    (while (< (+ PtCount 1) (length PtLst))             ;;Loop the coordinates
      (setq MyPt (nth PtCount PtLst))                   ;;nth coordinate
      (setq MyFullEnt (list MyEnt MyPt) )               ;;Add point to selected entity
      (command "Break" MyFullEnt "F" MyPT MyPt)         ;;Break entity
      (setq PtCount (+ PtCount 1))                      ;;increase counter
    ) ; end while                                       ;;end loop
    (setq n (+ n 1))                                    ;;increase loop counter
  ) ; end while                                         ;;end loop
  (princ)                                               ;;end quietly
)

 

That works perfect thanks Steven.

  • Like 1
Posted
4 hours ago, Tsuky said:

@DavidP

I can offer you another version to do what you want.
If you also use Map3D or Civil3D with object data, this data is preserved for each cut segment.

(defun c:break_lw@vtx_withOD ( / js i ent dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef )
  (initget "All Select")
  (if (eq (getkword "\nLWPolyline(s) to break at each vertex? [All/Select] <Select>: ") "All")
    (setq
      js
        (ssget "_X" 
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      i -1
    )
    (setq
      js
        (ssget
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      i -1
    )
  )
  (cond
    (js
      (repeat (sslength js)
        (setq
          dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))) (list "*"))
          xd_l (assoc -3 dxf_obj)
        )
        (if (cdr (assoc 43 dxf_obj))
          (setq dxf_43 (cdr (assoc 43 dxf_obj)))
          (setq dxf_43 0.0)
        )
        (if (cdr (assoc 38 dxf_obj))
          (setq dxf_38 (cdr (assoc 38 dxf_obj)))
          (setq dxf_38 0.0)
        )
        (if (cdr (assoc 39 dxf_obj))
          (setq dxf_39 (cdr (assoc 39 dxf_obj)))
          (setq dxf_39 0.0)
        )
        (setq
          dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
          dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
          dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
          dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
          dxf_210 (cdr (assoc 210 dxf_obj))
        )
        (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
          (setq
            dxf_10 (append dxf_10 (list (car dxf_10)))
            dxf_40 (append dxf_40 (list (car dxf_40)))
            dxf_41 (append dxf_41 (list (car dxf_41)))
            dxf_42 (append dxf_42 (list (car dxf_42)))
            n (cdr (assoc 90 dxf_obj))
          )
          (setq n (1- (cdr (assoc 90 dxf_obj))))
        )
        (repeat n
          (entmake
            (append
              (list
                (cons 0 "LWPOLYLINE")
                (cons 100 "AcDbEntity")
                (assoc 67 dxf_obj)
                (assoc 410 dxf_obj)
                (assoc 8 dxf_obj)
                (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
                (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
                (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
                (cons 100 "AcDbPolyline")
                (cons 90 2)
                (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
                (cons 38 dxf_38)
                (cons 39 dxf_39)
                (cons 10 (car dxf_10))
                (cons 40 (car dxf_40))
                (cons 41 (car dxf_41))
                (cons 42 (car dxf_42))
                (cons 10 (cadr dxf_10))
                (cons 40 (cadr dxf_40))
                (cons 41 (cadr dxf_41))
                (cons 42 (cadr dxf_42))
                (assoc 210 dxf_obj)
              )
              (if xd_l (list xd_l) '())
            )
          )
          (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast))
          (if
            (or
              (numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
              (numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
            )
            (progn
              (foreach n (ade_odgettables ent)
                (setq tbldef (ade_odtabledefn n))
                (setq lst_data
                  (cons
                    (mapcar
                      '(lambda (fld / tmp_rec numrec)
                        (setq numrec (ade_odrecordqty ent n))
                        (cons
                          n
                          (while (not (zerop numrec))
                            (setq numrec (1- numrec))
                            (if (zerop numrec)
                              (if tmp_rec
                                (cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                                (cons fld (ade_odgetfield ent n fld numrec))
                              )
                              (setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                            )
                          )
                        )
                      )
                      (mapcar 'cdar (cdaddr tbldef))
                    )
                    lst_data
                  )
                )
              )
              (cond
                (lst_data
                  (mapcar
                    '(lambda (x / ct)
                      (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                        (ade_odaddrecord nwent (caar x))
                      )
                      (foreach el (mapcar 'cdr x)
                        (if (listp (cdr el))
                          (progn
                            (setq ct -1)
                            (mapcar
                              '(lambda (y / )
                                (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                              )
                              (cadr el)
                            )
                          )
                          (ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                        )
                      )
                    )
                    lst_data
                  )
                )
              )
            )
          )
        )
        (entdel ent)
      )
      (print (sslength js)) (princ " LWpolyline(s) breaked at its vertices with its Object Datas.")
    )
  )
  (prin1)
)

 

I do use ACAD Map so this could be very handy. Thanks Tsuky this works great. 

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.

×
×
  • Create New...