TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ktbjx on April 03, 2020, 03:30:10 PM
-
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???
(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.
(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
-
Replace
(setq ss (ssget '((0 . "LWPOLYLINE"))))
with(setq ss (ssget "_A"))
or remove'((0 . "LWPOLYLINE")) ; <-- Your filters
from the second one.
-
Replace (setq ss (ssget '((0 . "LWPOLYLINE"))))
with(setq ss (ssget "_A"))
sir i tried the
(setq ss (ssget "_A"))
the routine keeps looping to only select 4 LWpolylines
or remove'((0 . "LWPOLYLINE")) ; <-- Your filters
from 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
-
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 (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) :knuppel2: :tickedoff:
-
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
-
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 (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) :knuppel2: :tickedoff:
@dlanor .. this function is missing a return if OPT is nil:
(defun rh:ss2lst
( ss opt
/ cnt lst
) )
);end_cond
);end_defun
Perhaps:
(defun rh:ss2lst
(ss opt
/ cnt lst
) lst
)
)
)
)
-
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 (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) :knuppel2: :tickedoff:
@dlanor .. this function is missing a return if OPT is nil:
(defun rh:ss2lst
( ss opt
/ cnt lst
) )
);end_cond
);end_defun
Perhaps:
(defun rh:ss2lst
(ss opt
/ cnt lst
) lst
)
)
)
)
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. :smitten:
-
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 (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) :knuppel2: :tickedoff:
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
-
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 (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) :knuppel2: :tickedoff:
@dlanor .. this function is missing a return if OPT is nil:
(defun rh:ss2lst
( ss opt
/ cnt lst
) )
);end_cond
);end_defun
Perhaps:
(defun rh:ss2lst
(ss opt
/ cnt lst
) lst
)
)
)
)
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. :smitten:
Cheers! :)