Topic: Make solid hatch from given plines

[ziele_o2k]

Please see attached dwg.

I have boudary (pline on Layer_1) and internal plines (on Layer_2)
I would like to get list of points to make solid hatch for every area.
For hatch I'm using this function:

Code: [Select]

;; By ElpanovEvgeniy
 ;; 03.04.2007 10:03:51:
(defun entmakex-hatch (L)
 (entmakex
  (apply
   'append
   (list
    (list '(0 . "HATCH")
          '(100 . "AcDbEntity")
          '(410 . "Model")
          '(100 . "AcDbHatch")
          '(10 0.0 0.0 0.0)
          '(210 0.0 0.0 1.0)
          '(2 . "SOLID")
          '(70 . 1)
          '(71 . 0)
          (cons 91 (length l))
    ) ;_  list
    (apply 'append
    (mapcar '(lambda (a)
             (apply 'append
                    (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
                          (mapcar '(lambda (b) (cons 10 b)) a)
                          '((97 . 0))
                    ) ;_  list
             ) ;_  apply
            ) ;_  lambda
            l
    ) ;_  mapcar
    )
    '((75 . 0)
      (76 . 1)
      (47 . 1.)
      (98 . 2)
      (10 0. 0. 0.0)
      (10 0. 0. 0.0)
      (451 . 0)
      (460 . 0.0)
      (461 . 0.0)
      (452 . 1)
      (462 . 1.0)
      (453 . 2)
      (463 . 0.0)
      (463 . 1.0)
      (470 . "LINEAR")
     )
   ) ;_  list
  ) ;_  apply
 ) ;_  entmakex
); _1)I would like to do that only with ssget plines on layer 1 and layer 2.
2)Second option is to ssget these plines and pick internal point for every area.
Any ideas how to do that?

[ribarm]

Does your polylines have arced segments? If so, then you can't use point list for (entmake) hatch - you have to do it through command "_.HATCH" or "_.BHATCH"... If your polylines have only straight segments, you can get point list with something like this :

(setq L (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lwpolyline))))
;;; lwpolyline = ename of desired LWPOLYLINE
;;; for ex.
(setq ss (ssget '((0 . "LWPOLYLINE") (8 . "Layer1")))) ;;; <--- you are prompted to select lwpolyline entities that reside on layer "Layer1" no matter if layer is locked or not...
(repeat (setq i (sslength ss))
  (setq lwpolyline (ssname ss (setq i (1- i))))
  (setq L (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lwpolyline))))
  (entmakex-hatch L)
)

[ziele_o2k]

My plines have only straight segments.
I know also how to get point list of lwpline.
Problem is, how to get list of points to make one hatch for every area?

[ziele_o2k]

In the meantime I found This post,
How to modify bbpoly for my purposes ?

[ribarm]

Evgeniy's code isn't quite appropriate for the task...
Here, try with this - tested on your DWG :

Code: [Select]

;; Batch BPoly  -  Lee Mac
;; Generates polylines for every region formed by a selection of lines & polylines
;; Restricted to LWPolylines with linear segments only.
;; Region generation based on a method by Stefan M.
;; Mod by M.R. to add ability for hatching resulting LWPOLYLINES

;; By ElpanovEvgeniy
;; 03.04.2007 10:03:51:
(defun entmakex-hatch (L)
 (entmakex
  (apply
   'append
   (list
    (list '(0 . "HATCH")
          '(100 . "AcDbEntity")
          '(410 . "Model")
          '(100 . "AcDbHatch")
          '(10 0.0 0.0 0.0)
          '(210 0.0 0.0 1.0)
          '(2 . "SOLID")
          '(70 . 1)
          '(71 . 0)
          '(91 . 1)
    ) ;_  list
    (apply 'append
      (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length L)))
      (mapcar '(lambda (b) (cons 10 b)) L)
      '((97 . 0))
      ) ;_  list
    ) ;_  apply
    '((75 . 0)
      (76 . 1)
      (47 . 1.)
      (98 . 2)
      (10 0. 0. 0.0)
      (10 0. 0. 0.0)
      (451 . 0)
      (460 . 0.0)
      (461 . 0.0)
      (452 . 1)
      (462 . 1.0)
      (453 . 2)
      (463 . 0.0)
      (463 . 1.0)
      (470 . "LINEAR")
     )
   ) ;_  list
  ) ;_  apply
 ) ;_  entmakex
); _

(defun c:bbpoly&hatch ( / *error* big ent enx idx int lst pt1 pt2 rtn sel spc tmp tot val var vtx entl )

    (defun *error* ( msg )
        (foreach obj rtn
            (if (and (vlax-write-enabled-p obj) (not (vlax-erased-p obj)))
                (vla-delete obj)
            )
        )
        (mapcar 'setvar var val)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (LM:startundo (LM:acdoc))
    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nCurrent layer locked.")
        )
        (   (setq sel
                (LM:ssget "\nSelect Lines & Polylines: "
                    (list
                        (list
                           '(-4 . "<OR")
                               '(0 . "LINE")
                               '(-4 . "<AND")
                                   '(0 . "LWPOLYLINE")
                                   '(-4 . "<NOT")
                                       '(-4 . "<>")
                                       '(42 . 0.0)
                                   '(-4 . "NOT>")
                               '(-4 . "AND>")
                           '(-4 . "OR>")
                            (if (= 1 (getvar 'cvport))
                                (cons 410 (getvar 'ctab))
                               '(410 . "Model")
                            )
                        )
                    )
                )
            )
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (repeat (setq idx (sslength sel))
                (if (= "LINE" (cdr (assoc 0 (setq enx (entget (ssname sel (setq idx (1- idx))))))))
                    (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) lst))
                    (setq vtx (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
                          vtx (mapcar 'list vtx (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (cons (last vtx) vtx) (cdr vtx)))
                          lst (append vtx lst)
                    )
                )
            )
            (foreach pl1 lst
                (setq pt1 (car  pl1)
                      pt2 (cadr pl1)
                )
                (foreach pl2 lst
                    (if
                        (and
                            (not (equal pl1 pl2 1e-8))
                            (setq int (inters pt1 pt2 (car pl2) (cadr pl2)))
                            (not (vl-member-if '(lambda ( pnt ) (equal pnt int 1e-8)) pl1))
                        )
                        (setq pl1 (cons int pl1))
                    )
                )
                (setq rtn
                    (append
                        (mapcar
                            (function
                                (lambda ( a b )
                                    (vla-addline spc
                                        (vlax-3D-point a)
                                        (vlax-3D-point b)
                                    )
                                )
                            )
                            (setq pl1
                                (vl-sort pl1
                                    (function
                                        (lambda ( a b )
                                            (< (distance pt1 a) (distance pt1 b))
                                        )
                                    )
                                )
                            )
                            (cdr pl1)
                        )
                        rtn
                    )
                )
            )
            (setq var '(cmdecho peditaccept)
                  val  (mapcar 'getvar var)
                  tot  0.0
            )
            (mapcar 'setvar var '(0 1))
            (foreach reg (vlax-invoke spc 'addregion rtn)
                (setq ent (entlast))
                (command "_.pedit" "_m")
                (apply 'command (mapcar 'vlax-vla-object->ename (vlax-invoke reg 'explode)))
                (command "" "_j" "" "")
                (if
                    (and
                        (not (eq ent (setq ent (entlast))))
                        (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
                    )
                    (progn
                        (setq tmp (vlax-curve-getarea ent)
                              tot (+ tot tmp)
                              entl (cons ent entl)
                        )
                        (if (< (car big) tmp)
                            (setq big (list tmp ent))
                        )
                    )
                )
                (vla-delete reg)
            )
            (if (equal (car big) (/ tot 2.0) 1e-3) ;; Gian Paolo Cattaneo
                (entdel (cadr big))
            )
            (foreach obj rtn (vla-delete obj))
            (mapcar 'setvar var val)
        )
    )
    (foreach ent entl
      (if (not (vlax-erased-p ent))
        (progn
          (entmakex-hatch (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget ent))))
          (entdel ent)
          (command "_.DRAWORDER" "_L" "" "_B")
        )
      )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

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

HTH

[ziele_o2k]

Evgeniy's code isn't quite appropriate for the task...

Maybe this:

Code - Auto/Visual Lisp: [Select]

1. (setq hobj (vla-addhatch spc achatchpatterntypepredefined "SOLID" :vlax-true achatchobject))
2.   (vla-appendouterloop hobj
3.     (vlax-make-variant
4.       (vlax-safearray-fill
5.         (vlax-make-safearray vlax-vbobject '(0 . 0))
6.         (list (vlax-ename->vla-object ent))
7.       )
8.     )
9.   )

in place of this

Code - Auto/Visual Lisp: [Select]

1. (entmakex-hatch (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget ent))))

[ribarm]

What I meant to say is that I've modified it slightly... Should be fine if you test my posted code with your DWG... Make sure you select appropriate polylines or make selection with (ssget '((0 . "LWPOLYLINE") (8 . "LAYER1,LAYER2")))... And then when asked for selection while routine, just pass "_Previous"... And that's it, new hatches should be created leaving boundaries unchanged (entdeleted bbpoly polylines)...

[ziele_o2k]

One more thing. Please see attached file.

Plines on layer_2 are with these Lee Mac function
And there is problem with small gaps when I whant to generate solids.
I have no idea where to start... any suggestions?

Function for makeing plines (to run this lisp you have to attached CADPL-Pack library:

Code - Auto/Visual Lisp: [Select]

1. (defun c:tests2p ( / *error* ss in ent lst newent)
2.   (defun *error* (msg / so)
3.     (cond
4.       ((not msg))
5.       ((member msg '("Function cancelled" "quit / exit abort")))
6.       (
7.         (princ (strcat "\n  <!>  Error: " msg "  <!> "))
8.         (cond (DebugMode (vl-bt)))
9.       )
10.     )  
11.     (princ)
12.   )
13.   (cd:SYS_UndoBegin)
14.   (if (setq ss (ssget '((0 . "SPLINE"))))
15.     (repeat (setq in (sslength ss))
16.       (setq
17.         ent (ssname ss (setq in (1- in)))
18.         lst
19.         (mapcar
20.           '(lambda (_1)
21.             (print _1)
22.             (list (car _1) (cadr _1))
23.           )
24.           (LM:Entity->PointList ent)
25.         )
26.       )
27.       (setq newent (vlax-vla-object->ename (cd:ACX_AddLWPolyline (cd:ACX_ASpace) lst nil)))
28.       (cd:ENT_SetDXF newent 8 (cdr (assoc 8 (entget ent))))
29.       (if (cdr (assoc 48 (entget ent)))
30.         (cd:ENT_SetDXF newent 48 (cdr (assoc 48 (entget ent))))
31.       )
32.       (cd:ENT_SetDXF newent 70 128)
33.       (entdel ent)
34.     )
35.   )
36.   (cd:SYS_UndoEnd)
37. )

[ribarm]

You did first step correct - you converted splines to lwpolylines... Then I've found that small gap that had to be connected, then I applied (c:bbpoly&hatch)... It seems that its OK... See DWG in attachment...

BTW. With splined geometry, hatch is I suppose complex to (entmakex), so you'd probably have to use commands, and beside that SPLINES derived from boundaries don't look quite perfect - look around intersecting vertices... See DWG in attachment...

HTH, M.R.

[ziele_o2k]

Then I've found that small gap that had to be connected

My question is, how to connect these plines not manualy but in my lisp tests2p.

[ribarm]

Then I've found that small gap that had to be connected

My question is, how to connect these plines not manualy but in my lisp tests2p.

It's a little complicated, but everything is possible if you want to do it with strong wish... I'd firstly search for intersection points using 'intersectwith method with ending parameter acextendboth... Then I'd compare those points with start/end points of plines... If (vlax-curve-getparamatpoint pline intpoint) ;;; pline - lwpoly ename ;;; intpoint - checking point from 'intersectwith method; returns a value, it means that you don't need to do anything - pline is crossing other pline/entity; but if it returns nil, you have to use "_.EXTEND" command, or even better (entmod) function applied in combination with (subst), so you can change start/end point of pline to match intpoint... That way prepared DWG is ready for next processing like (c:bbpoly&hatch), or if you wish just (c:bbpoly) after which you can manually or again automatically process extrusions on resulting LWPOLYLINES that are closed...

[ribarm]

Not to struggle too much, I've checked my library and I already have something that can help you... First you convert splines to lwpolylines like you know, then you use "plintav-adv.lsp" and then "weld2d.lsp" with fuzz 0.5... The DWG should be prepared for next (c:bbpoly&hatch) or (c:bbpoly)... Now if you want all to be automatic, all you have to do is figure out how to combine those lisps into single one you'll plan to use...

HTH, M.R.

[ziele_o2k]

I came up with something like this

Code - Auto/Visual Lisp: [Select]

1. (defun c:tee4 nil (PZ:FindPlinesToModify (ssget '((0 . "LWPOLYLINE")))))
2. (defun PZ:FindPlinesToModify (ss / EntLst tmpLst)
3.   (setq EntLst (LM:ss->ent ss))
4.   (setq finalLst
5.     (mapcar
6.       '(lambda (_1)
7.         (setq tmpLst
8.           (list _1
9.             (caar
10.               (vl-sort
11.                 (mapcar
12.                   '(lambda (_2)
13.                     (list
14.                       ;_1
15.                       _2
16.                       (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object _2) (vlax-curve-getStartPoint _1)) (vlax-curve-getStartPoint _1))
17.                     )
18.                   )
19.                   (LM:ListDifference EntLst (list _1))
20.                 )
21.                 (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
22.               )
23.             )
24.             (caar
25.               (vl-sort
26.                 (mapcar
27.                   '(lambda (_2)
28.                     (list
29.                       ;_1
30.                       _2
31.                       (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object _2) (vlax-curve-getEndPoint _1)) (vlax-curve-getEndPoint _1))
32.                     )
33.                   )
34.                   (LM:ListDifference EntLst (list _1))
35.                 )
36.                 (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
37.               )
38.             )
39.           )
40.         )
41.       )
42.       EntLst
43.     )
44.   )
45.   (princl finalLst)
46. )
47. ;; Print List  -  Lee Mac
48. ;; Prints a supplied list to the command-line or to a given filename,
49. ;; with nested lists displayed in a hierarchical format.
50. ;; l - [lst] List to print
51. ;; f - [str] Optional filename
52. (defun LM:princl ( l f / _print _princ d r )
53.    
54.     (defun _print ( l i )
55.         (if (and (= 'list (type l)) (vl-list-length l) (vl-some 'vl-consp l))
56.             (progn
57.                 (_princ (strcat "\n" i "("))
58.                 (foreach x l (_print x (strcat i "    ")))
59.                 (_princ (strcat "\n" i ")"))
60.             )
61.             (_princ (strcat "\n" i (vl-prin1-to-string l)))
62.         )
63.     )
64.  
65.     (eval
66.         (list 'defun '_princ '( x )
67.             (if (and (= 'str (type f)) (setq d (open f "w")))
68.                 (list 'princ 'x d)
69.                '(princ x)
70.             )
71.         )
72.     )
73.  
74.     (setq r (vl-catch-all-apply '_print (list l "")))
75.     (if (= 'file (type d))
76.         (progn
77.             (setq d (close d))
78.             (startapp "notepad" f)
79.         )
80.     )
81.     (if (vl-catch-all-error-p r)
82.         (prompt (vl-catch-all-error-message r))
83.         l
84.     )
85. )
86. (defun princl ( l ) (LM:princl l nil) (princ))
87. (defun princf ( l ) (LM:princl l (vl-filename-mktemp "list" (getvar 'dwgprefix) ".txt")) (princ))
88. (princ)
89. ;;-------------------=={ List Difference }==------------------;;
90. ;;                                                            ;;
91. ;;  Returns items appearing exclusively in one list but not   ;;
92. ;;  another, i.e. the relative complement: l1 \ l2            ;;
93. ;;------------------------------------------------------------;;
94. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
95. ;;------------------------------------------------------------;;
96. ;;  Arguments:                                                ;;
97. ;;  l1,l2 - lists for which to return the difference          ;;
98. ;;------------------------------------------------------------;;
99. ;;  Returns:  List of items appearing exclusively in list l1  ;;
100. ;;------------------------------------------------------------;;
101. (defun LM:ListDifference ( l1 l2 )
102.   (vl-remove-if '(lambda ( x ) (member x l2)) l1)
103. )
104. ;;--------------=={ SelectionSet -> Entities }==--------------;;
105. ;;                                                            ;;
106. ;;  Converts a SelectionSet to a list of Entities             ;;
107. ;;------------------------------------------------------------;;
108. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
109. ;;------------------------------------------------------------;;
110. ;;  Arguments:                                                ;;
111. ;;  ss - Valid SelectionSet (Pickset)                         ;;
112. ;;------------------------------------------------------------;;
113. ;;  Returns:  List of Entity names, else nil                  ;;
114. ;;------------------------------------------------------------;;
115. (defun LM:ss->ent ( ss / i l )
116.     (if ss
117.         (repeat (setq i (sslength ss))
118.             (setq l (cons (ssname ss (setq i (1- i))) l))
119.         )
120.     )
121. )
122.  

My final list looks like this:

Code: [Select]

(
    (<Nazwa elementu: 7ffff9132c0> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff9132b0>)
    (<Nazwa elementu: 7ffff9132b0> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913200>)
    (<Nazwa elementu: 7ffff9132a0> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913290>)
    (<Nazwa elementu: 7ffff913290> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913250>)
    (<Nazwa elementu: 7ffff913250> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913200>)
    (<Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff9132a0> <Nazwa elementu: 7ffff913250>)
)Where first element of sublist is entity of pline to extend, second is entity to which should be extended start point of pline to extend and third element is entity of pline to which should be extended end point of pline to extend.
Now I have to figure out how to do that....
I'm thinking to use something from Lee Mac page, but I have to add some coding for closest intersection of start and end point of polyline to extend.
Intersection with (depend on mode) can return to much intersection points.

[ribarm]

If I may comment your code... I don't quite see how do you plan to use it on your example - gap between start/end point of one pline and closest point of intersection on other pline somewhere on other pline - not start/end vertex... What I stated earlier is logical solution to this task IMHO and 'intersectwith method should be used - well it depends what parameter should you choose acextendthisentity, or acextendotherentity, or alternatively (but I am not 100% sure acextendboth) (acextendnone IMO you should avoid)... I know that my "plintav-adv.lsp" creates additional vertices that may be unnecessary, but you derive lwpolylines from splines anyway and some approximation is therefore applied from the very beginning of process... If I may ask : Do you really need plines? Can you use REGIONS instead? What do you plan to do after when routine is processed? Do you need hatching or extrusions for 3d modelling? Either way it looks that you can avoid all this by simply using BPOLY command with REGION option and then hatch manually or extrude or loft or sweep that region or revolve it or...? Am I right if I may say so that you're loosing time by coding something that could be done faster by manual using commands in command line?

[ziele_o2k]

This is how I want to use this. This coding below has big bugs but this is my direction.

New function is PZ:ExtendPline

Code - Auto/Visual Lisp: [Select]

1. (defun c:tee4 nil (PZ:FindPlinesToModify (ssget '((0 . "LWPOLYLINE")))))
2. (defun PZ:FindPlinesToModify (ss / *error* PZ:ExtendPline EntLst tmpLst)
3.   (defun *error* (msg / so)
4.     (cond
5.       ((not msg))
6.       ((member msg '("Function cancelled" "quit / exit abort")))
7.       (
8.         (princ (strcat "\n  <!>  Error : " msg "  <!> "))
9.         (cond (DebugMode (vl-bt)))
10.       )
11.     )  
12.     (princ)
13.   )
14.   (defun PZ:ExtendPline ( lst / vla_lst pl_m vla_pl_s vla_pl_e tmpLine_s tmpLine_e pts eds pte ede )
15.     (setq
16.       vla_lst (mapcar 'vlax-ename->vla-object lst)
17.       pl_m (car lst)
18.       vla_pl_s (cadr vla_lst)
19.       vla_pl_e (caddr vla_lst)
20.     )
21.     (setq
22.       tmpLine_s
23.       (cd:ACX_AddLine
24.         (cd:ACX_ASpace)
25.         (vlax-curve-getPointAtParam pl_m (vlax-curve-getStartParam pl_m))
26.         (vlax-curve-getPointAtParam pl_m (1+ (vlax-curve-getStartParam pl_m)))
27.         nil
28.       )
29.       tmpLine_e
30.       (cd:ACX_AddLine
31.         (cd:ACX_ASpace)
32.         (vlax-curve-getPointAtParam pl_m (1- (vlax-curve-getEndParam pl_m)))
33.         (vlax-curve-getPointAtParam pl_m (vlax-curve-getEndParam pl_m))
34.         nil
35.       )
36.     )
37.     (cond
38.       (
39.         (setq pts (car(LM:intersections tmpLine_s vla_pl_s acextendnone)))
40.         (setq eds (subst (cons 10 (list (car pts) (cadr pts))) (assoc 10 (entget pl_m)) (entget pl_m)))
41.       )
42.       (
43.         (setq pts (car(LM:intersections tmpLine_s vla_pl_s acextendthisentity)))
44.         (setq eds (subst (cons 10 (list (car pts) (cadr pts))) (assoc 10 (entget pl_m)) (entget pl_m)))
45.       )
46.     )
47.     (entmod eds)
48.     (cond
49.       (
50.         (setq pte (car(LM:intersections tmpLine_e vla_pl_e acextendnone)))
51.         (setq ede (subst (cons 10 (list (car pte) (cadr pte))) (assoc 10 (reverse(entget pl_m))) (entget pl_m)))
52.       )
53.       (
54.         (setq pte (car(LM:intersections tmpLine_e vla_pl_e acextendthisentity)))
55.         (setq ede (subst (cons 10 (list (car pte) (cadr pte))) (assoc 10 (reverse(entget pl_m))) (entget pl_m)))
56.       )
57.     )
58.     (entmod ede)
59.     (vla-Delete tmpLine_s)
60.     (vla-Delete tmpLine_e)
61.   )
62.   (setq EntLst (LM:ss->ent ss))
63.   (setq finalLst
64.     (mapcar
65.       '(lambda (_1)
66.         (setq tmpLst
67.           (list _1
68.             (caar
69.               (vl-sort
70.                 (mapcar
71.                   '(lambda (_2)
72.                     (list
73.                       ;_1
74.                       _2
75.                       (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object _2) (vlax-curve-getStartPoint _1)) (vlax-curve-getStartPoint _1))
76.                     )
77.                   )
78.                   (LM:ListDifference EntLst (list _1))
79.                 )
80.                 (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
81.               )
82.             )
83.             (caar
84.               (vl-sort
85.                 (mapcar
86.                   '(lambda (_2)
87.                     (list
88.                       ;_1
89.                       _2
90.                       (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object _2) (vlax-curve-getEndPoint _1)) (vlax-curve-getEndPoint _1))
91.                     )
92.                   )
93.                   (LM:ListDifference EntLst (list _1))
94.                 )
95.                 (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
96.               )
97.             )
98.           )
99.         )
100.       )
101.       EntLst
102.     )
103.   )
104.   (foreach _n finalLst (PZ:ExtendPline _n))
105.   (princl finalLst)
106. )
107. ;; Intersections  -  Lee Mac
108. ;; Returns a list of all points of intersection between two objects
109. ;; for the given intersection mode.
110. ;; ob1,ob2 - [vla] VLA-Objects
111. ;;     mod - [int] acextendoption enum of intersectwith method
112.  
113. (defun LM:intersections ( ob1 ob2 mod / lst rtn )
114.     (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
115.     (repeat (/ (length lst) 3)
116.         (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
117.               lst (cdddr lst)
118.         )
119.     )
120.     (reverse rtn)
121. )
122. ;; Print List  -  Lee Mac
123. ;; Prints a supplied list to the command-line or to a given filename,
124. ;; with nested lists displayed in a hierarchical format.
125. ;; l - [lst] List to print
126. ;; f - [str] Optional filename
127. (defun LM:princl ( l f / _print _princ d r )
128.  
129.     (defun _print ( l i )
130.         (if (and (= 'list (type l)) (vl-list-length l) (vl-some 'vl-consp l))
131.             (progn
132.                 (_princ (strcat "\n" i "("))
133.                 (foreach x l (_print x (strcat i "    ")))
134.                 (_princ (strcat "\n" i ")"))
135.             )
136.             (_princ (strcat "\n" i (vl-prin1-to-string l)))
137.         )
138.     )
139.  
140.     (eval
141.         (list 'defun '_princ '( x )
142.             (if (and (= 'str (type f)) (setq d (open f "w")))
143.                 (list 'princ 'x d)
144.                '(princ x)
145.             )
146.         )
147.     )
148.  
149.     (setq r (vl-catch-all-apply '_print (list l "")))
150.     (if (= 'file (type d))
151.         (progn
152.             (setq d (close d))
153.             (startapp "notepad" f)
154.         )
155.     )
156.     (if (vl-catch-all-error-p r)
157.         (prompt (vl-catch-all-error-message r))
158.         l
159.     )
160. )
161. (defun princl ( l ) (LM:princl l nil) (princ))
162. (defun princf ( l ) (LM:princl l (vl-filename-mktemp "list" (getvar 'dwgprefix) ".txt")) (princ))
163. (princ)
164. ;;-------------------=={ List Difference }==------------------;;
165. ;;                                                            ;;
166. ;;  Returns items appearing exclusively in one list but not   ;;
167. ;;  another, i.e. the relative complement: l1 \ l2            ;;
168. ;;------------------------------------------------------------;;
169. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
170. ;;------------------------------------------------------------;;
171. ;;  Arguments:                                                ;;
172. ;;  l1,l2 - lists for which to return the difference          ;;
173. ;;------------------------------------------------------------;;
174. ;;  Returns:  List of items appearing exclusively in list l1  ;;
175. ;;------------------------------------------------------------;;
176. (defun LM:ListDifference ( l1 l2 )
177.   (vl-remove-if '(lambda ( x ) (member x l2)) l1)
178. )
179. ;;--------------=={ SelectionSet -> Entities }==--------------;;
180. ;;                                                            ;;
181. ;;  Converts a SelectionSet to a list of Entities             ;;
182. ;;------------------------------------------------------------;;
183. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
184. ;;------------------------------------------------------------;;
185. ;;  Arguments:                                                ;;
186. ;;  ss - Valid SelectionSet (Pickset)                         ;;
187. ;;------------------------------------------------------------;;
188. ;;  Returns:  List of Entity names, else nil                  ;;
189. ;;------------------------------------------------------------;;
190. (defun LM:ss->ent ( ss / i l )
191.     (if ss
192.         (repeat (setq i (sslength ss))
193.             (setq l (cons (ssname ss (setq i (1- i))) l))
194.         )
195.     )
196. )

[ribarm]

This is how would I do it, but I am still not sure why all this... You can simply get REGIONS with BPOLY command and with original SPLINE entities and then do whatever you like after... Also if you have open SPLINES like in your case, you may use CAB's BreakObjects.lsp posted here at www.theswamp.org at forum show your stuff, to break SPLINES after which you can simply use REGION command to extract REGIONS... Of course you remove biggest one, but that's actually all you have to do - the effect is the same as bbpoly by Lee Mac if not even better (SPLINES don't degrade when in REGIONS)... Anyway here is my version and it don't have bugs...

Code - Auto/Visual Lisp: [Select]

1. (defun c:extshortlwsaddv ( / *error* bbucs intersobj1obj2 add_vtx *adoc* ucsf ss i ent fuzz ll ur bbl ent1 ent2 ss-ent1 k intpts )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( m )
6.     (if ucsf
7.       (command "_.UCS" "_P")
8.     )
9.     (vla-endundomark *adoc*)
10.     (if m
11.       (prompt m)
12.     )
13.     (princ)
14.   )
15.  
16.   (defun bbucs ( ss / UCS2WCSMatrix WCS2UCSMatrix n ent minpt maxpt minptlst maxptlst minptbbx minptbby minptbbz minptbb maxptbbx maxptbby maxptbbz maxptbb )
17.  
18.     (vl-load-com)
19.  
20.     ;; Doug C. Broad, Jr.
21.     ;; can be used with vla-transformby to
22.     ;; transform objects from the UCS to the WCS
23.     (defun UCS2WCSMatrix ()
24.       (vlax-tmatrix
25.         (append
26.           (mapcar
27.            '(lambda (vector origin)
28.             (append (trans vector 1 0 t) (list origin))
29.           )
30.           (list '(1 0 0) '(0 1 0) '(0 0 1))
31.           (trans '(0 0 0) 0 1)
32.           )
33.           (list '(0 0 0 1))
34.         )
35.       )
36.     )
37.     ;; transform objects from the WCS to the UCS
38.     (defun WCS2UCSMatrix ()
39.       (vlax-tmatrix
40.         (append
41.           (mapcar
42.            '(lambda (vector origin)
43.             (append (trans vector 0 1 t) (list origin))
44.           )
45.           (list '(1 0 0) '(0 1 0) '(0 0 1))
46.           (trans '(0 0 0) 1 0)
47.           )
48.           (list '(0 0 0 1))
49.         )
50.       )
51.     )
52.  
53.     (if ss
54.       (progn
55.         (repeat (setq n (sslength ss))
56.           (setq ent (ssname ss (setq n (1- n))))
57.           (vla-TransformBy (vlax-ename->vla-object ent) (UCS2WCSMatrix))
58.           (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
59.           (vla-TransformBy (vlax-ename->vla-object ent) (WCS2UCSMatrix))
60.           (setq minpt (vlax-safearray->list minpoint))
61.           (setq maxpt (vlax-safearray->list maxpoint))
62.           (setq minptlst (cons minpt minptlst))
63.           (setq maxptlst (cons maxpt maxptlst))
64.         )
65.         (setq minptbbx (caar (vl-sort minptlst '(lambda (a b) (< (car a) (car b))))))
66.         (setq minptbby (cadar (vl-sort minptlst '(lambda (a b) (< (cadr a) (cadr b))))))
67.         (setq minptbbz (caddar (vl-sort minptlst '(lambda (a b) (< (caddr a) (caddr b))))))
68.         (setq maxptbbx (caar (vl-sort maxptlst '(lambda (a b) (> (car a) (car b))))))
69.         (setq maxptbby (cadar (vl-sort maxptlst '(lambda (a b) (> (cadr a) (cadr b))))))
70.         (setq maxptbbz (caddar (vl-sort maxptlst '(lambda (a b) (> (caddr a) (caddr b))))))
71.         (setq minptbb (list minptbbx minptbby minptbbz))
72.         (setq maxptbb (list maxptbbx maxptbby maxptbbz))
73.       )
74.     )
75.     (list minptbb maxptbb)
76.   )
77.  
78.   (defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
79.     (if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
80.     (if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
81.     (setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendBoth))))))
82.     (if (vl-catch-all-error-p coords)
83.       (setq ptlst nil)
84.       (repeat (/ (length coords) 3)
85.         (setq pt (list (car coords) (cadr coords) (caddr coords)))
86.         (setq ptlst (cons pt ptlst))
87.         (setq coords (cdddr coords))
88.       )
89.     )
90.     ptlst
91.   )
92.  
93.   (defun add_vtx ( obj add_pt ent_name / bulg sw ew )
94.       (vla-GetWidth obj (fix add_pt) 'sw 'ew)
95.       (vla-addVertex
96.           obj
97.           (1+ (fix add_pt))
98.           (vlax-make-variant
99.               (vlax-safearray-fill
100.                   (vlax-make-safearray vlax-vbdouble (cons 0 1))
101.                       (list
102.                           (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
103.                           (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
104.                       )
105.               )
106.           )
107.       )
108.       (setq bulg (vla-GetBulge obj (fix add_pt)))
109.       (vla-SetBulge obj
110.           (fix add_pt)
111.           (/
112.               (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
113.               (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
114.           )
115.       )
116.       (vla-SetBulge obj
117.           (1+ (fix add_pt))
118.           (/
119.               (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
120.               (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
121.           )
122.       )
123.       (vla-SetWidth obj (fix add_pt) sw (+ sw (* (- ew sw) (- add_pt (fix add_pt)))))
124.       (vla-SetWidth obj (1+ (fix add_pt)) (+ sw (* (- ew sw) (- add_pt (fix add_pt)))) ew)
125.       (vla-update obj)
126.   )
127.  
128.   (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
129.   (if (= (getvar 'worlducs) 0)
130.     (progn
131.       (command "_.UCS" "_W")
132.       (setq ucsf t)
133.     )
134.   )
135.   (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
136.   (repeat (setq i (sslength ss))
137.     (setq ent (ssname ss (setq i (1- i))))
138.     (if (not (and (vlax-curve-isplanar ent) (equal (caddr (vlax-curve-getstartpoint ent)) 0.0 1e-6)))
139.       (ssdel ent ss)
140.     )
141.   )
142.   (setq fuzz 0.51)
143.   (while (> fuzz 0.5)
144.     (initget 6)
145.     (setq fuzz (getdist "\nPick or specify fuzz distance <1e-2> - should not be greater than 0.5 : "))
146.     (if (null fuzz)
147.       (setq fuzz 1e-2)
148.     )
149.   )
150.   (setq ll (car (bbucs ss)) ur (cadr (bbucs ss)))
151.   (setq bbl (list ll (list (car ur) (cadr ll)) ur (list (car ll) (cadr ur))))
152.   (repeat (setq i (sslength ss))
153.     (setq ent1 (ssname ss (setq i (1- i))))
154.     (vla-getboundingbox (vlax-ename->vla-object ent1) 'll 'ur)
155.     (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
156.     (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point ll) (vlax-3d-point ur))
157.     (setq ss-ent1 (ssget "_CP" bbl '((0 . "LWPOLYLINE"))))
158.     (vla-zoomprevious (vlax-get-acad-object))
159.     (ssdel ent1 ss-ent1)
160.     (repeat (setq k (sslength ss-ent1))
161.       (setq ent2 (ssname ss-ent1 (setq k (1- k))))
162.       (setq intpts (intersobj1obj2 ent1 ent2))
163.       (if intpts
164.         (foreach pt intpts
165.           (if
166.             (or
167.               (and
168.                 (vlax-curve-getparamatpoint ent1 pt)
169.                 (not (vlax-curve-getparamatpoint ent2 pt))
170.               )
171.               (and
172.                 (not (vlax-curve-getparamatpoint ent1 pt))
173.                 (vlax-curve-getparamatpoint ent2 pt)
174.               )
175.             )
176.             (cond
177.               ( (and (vlax-curve-getparamatpoint ent1 pt) (not (equal (vlax-curve-getparamatpoint ent1 pt) (vlax-curve-getstartparam ent1) 1e-5)) (not (equal (vlax-curve-getparamatpoint ent1 pt) (vlax-curve-getendparam ent1) 1e-5)) (or (<= (distance (vlax-curve-getstartpoint ent2) pt) fuzz) (<= (distance (vlax-curve-getendpoint ent2) pt) fuzz)))
178.                 (add_vtx (vlax-ename->vla-object ent1) (vlax-curve-getparamatpoint ent1 pt) ent1)
179.                 (cond
180.                   ( (<= (distance (vlax-curve-getstartpoint ent2) pt) fuzz)
181.                     (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car pt) (cadr pt))) (assoc 10 (entget ent2)) (entget ent2))))))
182.                   )
183.                   ( (<= (distance (vlax-curve-getendpoint ent2) pt) fuzz)
184.                     (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car pt) (cadr pt))) (assoc 10 (reverse (entget ent2))) (entget ent2))))))
185.                   )
186.                 )
187.               )
188.               ( (and (vlax-curve-getparamatpoint ent2 pt) (not (equal (vlax-curve-getparamatpoint ent2 pt) (vlax-curve-getstartparam ent2) 1e-5)) (not (equal (vlax-curve-getparamatpoint ent2 pt) (vlax-curve-getendparam ent2) 1e-5)) (or (<= (distance (vlax-curve-getstartpoint ent1) pt) fuzz) (<= (distance (vlax-curve-getendpoint ent1) pt) fuzz)))
189.                 (add_vtx (vlax-ename->vla-object ent2) (vlax-curve-getparamatpoint ent2 pt) ent2)
190.                 (cond
191.                   ( (<= (distance (vlax-curve-getstartpoint ent1) pt) fuzz)
192.                     (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car pt) (cadr pt))) (assoc 10 (entget ent1)) (entget ent1))))))
193.                   )
194.                   ( (<= (distance (vlax-curve-getendpoint ent1) pt) fuzz)
195.                     (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car pt) (cadr pt))) (assoc 10 (reverse (entget ent1))) (entget ent1))))))
196.                   )
197.                 )
198.               )
199.             )
200.           )
201.         )
202.       )
203.     )
204.   )
205.   (*error* nil)
206. )
207.  

M.R.

[ziele_o2k]

Hatching with splines boundary has big problems with displaying hatches (maybe not with SOLID but for exapmle with ANSI38 ) so I don't want to use _bpoly.
Problems occurs in most of cad programs (AutoCad; GstarCad; ZWCad).
Below my final version to extend/trim plines.

Code - Auto/Visual Lisp: [Select]

1. (defun c:tee4 nil (PZ:FindPlinesToModify (ssget '((0 . "LWPOLYLINE")))))
2. (defun PZ:FindPlinesToModify (ss / *error* PZ:ExtendPline EntLst tmpLst)
3.   (defun *error* (msg / so)
4.     (cond
5.       ((not msg))
6.       ((member msg '("Function cancelled" "quit / exit abort")))
7.       (
8.         (princ (strcat "\n  <!>  Error : " msg "  <!> "))
9.         (cond (DebugMode (vl-bt)))
10.       )
11.     )  
12.     (princ)
13.   )
14.   (defun PZ:ExtendPline ( lst / vla_lst pl_m vla_pl_s vla_pl_e tmpLine_s tmpLine_e pts eds pte ede )
15.     (setq
16.       vla_lst (mapcar 'vlax-ename->vla-object lst)
17.       pl_m (car lst)
18.       vla_pl_s (cadr vla_lst)
19.       vla_pl_e (caddr vla_lst)
20.     )
21.     (setq
22.       tmpLine_s
23.       (cd:ACX_AddLine
24.         (cd:ACX_ASpace)
25.         (vlax-curve-getPointAtParam pl_m (vlax-curve-getStartParam pl_m))
26.         (vlax-curve-getPointAtParam pl_m (1+ (vlax-curve-getStartParam pl_m)))
27.         nil
28.       )
29.       tmpLine_e
30.       (cd:ACX_AddLine
31.         (cd:ACX_ASpace)
32.         (vlax-curve-getPointAtParam pl_m (1- (vlax-curve-getEndParam pl_m)))
33.         (vlax-curve-getPointAtParam pl_m (vlax-curve-getEndParam pl_m))
34.         nil
35.       )
36.     )
37.     (cond
38.       (
39.         (eq (logand(cdr (assoc 70 (entget pl_m))) 1) 1);(eq (logand(cdr (assoc 70 (entget (car(entsel))))) 1) 1)
40.         nil
41.       );skip closed plines
42.       (
43.         (setq pts (car(LM:intersections tmpLine_s vla_pl_s acextendnone)))
44.         (setq eds (subst (cons 10 (list (car pts) (cadr pts))) (assoc 10 (entget pl_m)) (entget pl_m)))
45.       )
46.       (
47.         (setq pts
48.           (caar
49.             (vl-sort
50.               (mapcar
51.                 '(lambda (_1)
52.                   (list _1 (distance _1 (vlax-curve-getPointAtParam pl_m (vlax-curve-getStartParam pl_m))))
53.                 )
54.                 (LM:intersections tmpLine_s vla_pl_s acextendthisentity)
55.               )
56.               (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
57.             )
58.           )
59.         )
60.         (setq eds (subst (cons 10 (list (car pts) (cadr pts))) (assoc 10 (entget pl_m)) (entget pl_m)))
61.       )
62.     )
63.     (entmod eds)
64.     (cond
65.       (
66.         (eq (logand(cdr (assoc 70 (entget pl_m))) 1) 1)
67.         nil
68.       );skip closed plines
69.       (
70.         (setq pte (car(LM:intersections tmpLine_e vla_pl_e acextendnone)))
71.         (setq ede (subst (cons 10 (list (car pte) (cadr pte))) (assoc 10 (reverse(entget pl_m))) (entget pl_m)))
72.       )
73.       (
74.         (setq pte
75.           (caar
76.             (vl-sort
77.               (mapcar
78.                 '(lambda (_1)
79.                   (list _1 (distance _1 (vlax-curve-getPointAtParam pl_m (vlax-curve-getEndParam pl_m))))
80.                 )
81.                 (LM:intersections tmpLine_e vla_pl_e acextendthisentity)
82.               )
83.               (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
84.             )
85.           )
86.         )
87.         (setq ede (subst (cons 10 (list (car pte) (cadr pte))) (assoc 10 (reverse(entget pl_m))) (entget pl_m)))
88.       )
89.     )
90.     (entmod ede)
91.     (vla-Delete tmpLine_s)
92.     (vla-Delete tmpLine_e)
93.   )
94.   (setq EntLst (LM:ss->ent ss))
95.   (setq finalLst
96.     (mapcar
97.       '(lambda (_1)
98.         (setq tmpLst
99.           (list _1
100.             (caar
101.               (vl-sort
102.                 (mapcar
103.                   '(lambda (_2)
104.                     (list
105.                       ;_1
106.                       _2
107.                       (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object _2) (vlax-curve-getStartPoint _1)) (vlax-curve-getStartPoint _1))
108.                     )
109.                   )
110.                   (LM:ListDifference EntLst (list _1))
111.                 )
112.                 (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
113.               )
114.             )
115.             (caar
116.               (vl-sort
117.                 (mapcar
118.                   '(lambda (_2)
119.                     (list
120.                       ;_1
121.                       _2
122.                       (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object _2) (vlax-curve-getEndPoint _1)) (vlax-curve-getEndPoint _1))
123.                     )
124.                   )
125.                   (LM:ListDifference EntLst (list _1))
126.                 )
127.                 (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
128.               )
129.             )
130.           )
131.         )
132.       )
133.       EntLst
134.     )
135.   )
136.   (foreach _n finalLst (PZ:ExtendPline _n))
137.   (princ)
138. )
139. ;;-------------------=={ List Difference }==------------------;;
140. ;;                                                            ;;
141. ;;  Returns items appearing exclusively in one list but not   ;;
142. ;;  another, i.e. the relative complement: l1 \ l2            ;;
143. ;;------------------------------------------------------------;;
144. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
145. ;;------------------------------------------------------------;;
146. ;;  Arguments:                                                ;;
147. ;;  l1,l2 - lists for which to return the difference          ;;
148. ;;------------------------------------------------------------;;
149. ;;  Returns:  List of items appearing exclusively in list l1  ;;
150. ;;------------------------------------------------------------;;
151. (defun LM:ListDifference ( l1 l2 )
152.   (vl-remove-if '(lambda ( x ) (member x l2)) l1)
153. )
154. ;;--------------=={ SelectionSet -> Entities }==--------------;;
155. ;;                                                            ;;
156. ;;  Converts a SelectionSet to a list of Entities             ;;
157. ;;------------------------------------------------------------;;
158. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
159. ;;------------------------------------------------------------;;
160. ;;  Arguments:                                                ;;
161. ;;  ss - Valid SelectionSet (Pickset)                         ;;
162. ;;------------------------------------------------------------;;
163. ;;  Returns:  List of Entity names, else nil                  ;;
164. ;;------------------------------------------------------------;;
165. (defun LM:ss->ent ( ss / i l )
166.     (if ss
167.         (repeat (setq i (sslength ss))
168.             (setq l (cons (ssname ss (setq i (1- i))) l))
169.         )
170.     )
171. )

To run, please load CadPack functions from this post.

Thank you ribarm for help!