Topic: Can someone edit this Lisp???

[ktbjx]

I dont know how to edit this lisp i found...
I like to remove the need to select polylines.
instead of selecting... can it be done to select whats ever is visible on screen???

Code: [Select]

(defun LD:ss2lst( ss opt / cnt lst)
  (cond ( (and ss (= (type ss) 'PICKSET))
          (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst))) 
          (if opt (setq lst (mapcar 'vlax-ename->vla-object lst)))
        )
  );end_cond
);end_defun

(defun LD:223 (lst z / a) (setq a (reverse (cons z (reverse lst)))))

(defun LD:322 (lst / a) (setq a (reverse (cdr (reverse lst)))))

(defun LD:trp (pt1 pt2 obj / xobj ent v xpt)
  (setq xobj (vlax-invoke *c_spc* 'addxline pt1 pt2)
        ent (vlax-vla-object->ename obj)
        v (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
        xpt (LD:322 (vlax-invoke xobj 'intersectwith obj acextendotherentity))
  );end_setq
  (if (> (distance xpt (car v)) (distance xpt (last v)))
    (setq v (reverse (cons xpt (cdr (reverse v)))))
    (setq v (cons xpt (cdr v)))
  );end_if
  (vla-delete xobj)
  (vlax-put obj 'coordinates (apply 'append v))
);end_defun

(vl-load-com)

(defun c:xtr ( / ss lst flst xlst ele v1 v2 xobj obj ent v3 xpt nlst)

  (or *c_doc* (setq *c_doc* (vla-get-activedocument (vlax-get-acad-object))))
  (or *c_spc* (setq *c_spc* (vlax-get-property *c_doc* (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))))
 
  (while (or (not ss) (/= (sslength ss) 4))
    (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (cond ( (not ss) (alert "Nothing Selected"))
          ( (/= (sslength ss) 4) (alert "Only Select 4 LWPolylines"))
    );end_cond
  );end_while
 
  (setq lst (LD:ss2lst ss t))
  (foreach x lst (if (= (vlax-get-property x 'color) 256) (setq flst (cons x flst)) (setq xlst (cons x xlst))))
  (setq lst (mapcar 'vlax-vla-object->ename xlst))
  (setq ele (cdr (assoc 38 (entget (car lst)))))
  (setq v1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car lst)))))
  (setq v2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (cadr lst)))))
 
  (if (> (distance (car v1) (car v2)) (distance (car v1) (last v2))) (setq v2 (reverse v2)))
  (LD:trp (LD:223 (car v1) ele) (LD:223 (car v2) ele) (car flst))
  (LD:trp (LD:223 (car v1) ele) (LD:223 (car v2) ele) (cadr flst))
  (LD:trp (LD:223 (last v1) ele) (LD:223 (last v2) ele) (car flst))
  (LD:trp (LD:223 (last v1) ele) (LD:223 (last v2) ele) (cadr flst))
  (foreach x xlst (vla-delete x))
  (setq lst (mapcar 'vlax-vla-object->ename flst))
  (setq v1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car lst)))))
  (setq v2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (cadr lst)))))
  (if (> (distance (car v1) (car v2)) (distance (car v1) (last v2)))
    (setq nlst (append v1 v2))
    (setq nlst (append v1 (reverse v2)))
  );end_if
  (vlax-put (car flst) 'coordinates (apply 'append nlst))
  (vlax-put-property (car flst) 'closed :vlax-true)
  (vla-delete (cadr flst))
  (princ)
);end_defun

(vl-load-com)

while searching i found this function... maybe its possible, but i dont know how to incorporate it.

Code: [Select]

  (defun LD:selonscreen ( / i rtn ss)
    (repeat
      (setq i
     (sslength
       (cond
((setq ss
(ssget "_C" ; <-- Crossing Window (only accept selection visible on screen by default)
(getvar "EXTMIN")
(getvar "EXTMAX")
'((0 . "LWPOLYLINE")) ; <-- Your filters
)
)
  )
((ssadd))
)
       )
    )
      (setq rtn (cons (ssname ss (setq i (1- i))) rtn))
      )
    (reverse rtn)
    )i just googled this function so IDK if its possible...
i just want to select the 4 lines visible on screen, instead of selecting it manually

[tombu]

Replace

Code: [Select]

(setq ss (ssget '((0 . "LWPOLYLINE"))))with

Code: [Select]

(setq ss (ssget "_A"))
or remove

Code: [Select]

'((0 . "LWPOLYLINE")) ; <-- Your filtersfrom the second one.

[ktbjx]

Replace

Code: [Select]

(setq ss (ssget '((0 . "LWPOLYLINE"))))with

Code: [Select]

(setq ss (ssget "_A"))

sir i tried the

Code: [Select]

(setq ss (ssget "_A"))
the routine keeps looping to only select 4 LWpolylines

or remove

Code: [Select]

'((0 . "LWPOLYLINE")) ; <-- Your filtersfrom the second one.

I am selecting LWPolylines though... I don't know how to add the function to the routine i got...
could you help me? i have no idea how to code lisp Im sorry

[Dlanor]

Look remarkably like the code I supplied on the 28 March https://www.cadtutor.net/forum/topic/70179-extend-or-trim-polyline-on-an-intersecting-line/?tab=comments#comment-563619

I suggest you ask the author (LD) 

[ronjonp]

Have a look here for functions to get the current screen coordinates. EXTMIN and EXTMAX don't do what that function name claims to do.
http://www.theswamp.org/index.php?topic=46661.msg516726#msg516726

[ronjonp]

Look remarkably like the code I supplied on the 28 March https://www.cadtutor.net/forum/topic/70179-extend-or-trim-polyline-on-an-intersecting-line/?tab=comments#comment-563619

I suggest you ask the author (LD) 

@dlanor .. this function is missing a return if OPT is nil:

Code - Auto/Visual Lisp: [Select]

1. (defun rh:ss2lst( ss opt / cnt lst)
2.   (cond ( (and ss (= (type ss) 'PICKSET))
3.           (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))  
4.           (if opt (setq lst (mapcar 'vlax-ename->vla-object lst)))
5.         )
6.   );end_cond
7. );end_defun

Perhaps:

Code - Auto/Visual Lisp: [Select]

1. (defun rh:ss2lst (ss opt / cnt lst)
2.   (cond ((and ss (= (type ss) 'pickset))
3.          (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))
4.          (if opt
5.            (mapcar 'vlax-ename->vla-object lst)
6.            lst
7.          )
8.         )
9.   )                            
10. )

[Dlanor]

Look remarkably like the code I supplied on the 28 March https://www.cadtutor.net/forum/topic/70179-extend-or-trim-polyline-on-an-intersecting-line/?tab=comments#comment-563619

I suggest you ask the author (LD) 

@dlanor .. this function is missing a return if OPT is nil:

Code - Auto/Visual Lisp: [Select]

1. (defun rh:ss2lst( ss opt / cnt lst)
2.   (cond ( (and ss (= (type ss) 'PICKSET))
3.           (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))  
4.           (if opt (setq lst (mapcar 'vlax-ename->vla-object lst)))
5.         )
6.   );end_cond
7. );end_defun

Perhaps:

Code - Auto/Visual Lisp: [Select]

1. (defun rh:ss2lst (ss opt / cnt lst)
2.   (cond ((and ss (= (type ss) 'pickset))
3.          (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))
4.          (if opt
5.            (mapcar 'vlax-ename->vla-object lst)
6.            lst
7.          )
8.         )
9.   )                            
10. )

I used a stripped back version, removing the last section of the cond statement and the final lst after the cond ended, as it's only called once with opt = T. Your version looks much neater codewise though. Many thanks Ron.

[ktbjx]

Look remarkably like the code I supplied on the 28 March https://www.cadtutor.net/forum/topic/70179-extend-or-trim-polyline-on-an-intersecting-line/?tab=comments#comment-563619

I suggest you ask the author (LD) 

hey! don't kill me, i dont own this code, i googled it the one thing i found is when 4 lines are too curved like letter C it gives a weird xline

[ronjonp]

Look remarkably like the code I supplied on the 28 March https://www.cadtutor.net/forum/topic/70179-extend-or-trim-polyline-on-an-intersecting-line/?tab=comments#comment-563619

I suggest you ask the author (LD) 

@dlanor .. this function is missing a return if OPT is nil:

Code - Auto/Visual Lisp: [Select]

1. (defun rh:ss2lst( ss opt / cnt lst)
2.   (cond ( (and ss (= (type ss) 'PICKSET))
3.           (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))  
4.           (if opt (setq lst (mapcar 'vlax-ename->vla-object lst)))
5.         )
6.   );end_cond
7. );end_defun

Perhaps:

Code - Auto/Visual Lisp: [Select]

1. (defun rh:ss2lst (ss opt / cnt lst)
2.   (cond ((and ss (= (type ss) 'pickset))
3.          (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))
4.          (if opt
5.            (mapcar 'vlax-ename->vla-object lst)
6.            lst
7.          )
8.         )
9.   )                            
10. )

I used a stripped back version, removing the last section of the cond statement and the final lst after the cond ended, as it's only called once with opt = T. Your version looks much neater codewise though. Many thanks Ron.

Cheers!