Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 06/25/2020 in all areas

  1. Thanks @Tharwat and @dlanorh and @ hanhphuc Sorry for my late reply The lisps were shown working great and I think beautiful thanks ALL
    2 points
  2. sorry i assume variant was 3d point.. so try to debug yourself , according to developer documentation it requires 2d doubles, ie: x,y not x,y,z read the article vlax-2d-point is built-in function BCAD (defun vlax-2d-point (pt) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) (list (car pt) (cadr pt)) ) ) ) eg. call (vlax-2d-point p1) ;#<variant 8197 ...> (mapcar 'vlax-2d-point (list p1 p2)) ;( #<variant 8197 ...> #<variant 8197 ...> ) hint trans & acWindow
    1 point
  3. I would suggest you remove your drawing from the post above. Another student might decide to "borrow" your hard work. I wasn't aware that Penn-Foster required hand sketches. No previous student post has ever mentioned that requirement. No, you do not need to show the angle in the plan view of the building. Angles will be shown in a different drawing mainly in details.
    1 point
  4. Nice Tharwat & dlnorh (defun foo (i l / n k) (setq n (length l)) (cond ((not i)(reverse l)) ((< i n) (repeat (1+ i) (setq k (cons (car l) k) l (cdr l) ) ) (apply 'append (mapcar 'reverse (list k l))) ) (t nil) ) ) this reverse (1+ nth) (setq lst '(1 2 3 4 5 6 7)) (foo nil lst) ;(7 6 5 4 3 2 1) (foo 0 lst) ;(1 7 6 5 4 3 2) (foo 3 lst) ;(1 2 3 4 7 6 5) (foo 6 lst) ;(1 2 3 4 5 6 7) (foo 7 lst) ; nil (defun revnth (n lst) ;hp 25.06.2020 ((lambda (f n l) (reverse (append (f (- (length lst) n) (reverse lst)) (f n lst)))) (list '(n l) '(if (> n 0) (cons (nth (1- n) l) (f (1- n) l)))) n l ) ) reverse at nth (setq lst '( 1 2 3 4 5 6 7 8 9 10 ) ) (revnth 0 lst) ; (10 9 8 7 6 5 4 3 2 1 0 ) (revnth 2 lst) ; (0 1 10 9 8 7 6 5 4 3 2 )
    1 point
  5. As there have been quite a few views on this topic, I decided to improve (?) the pattern file, and also scale it for a one unit spacing. *Query1,question mark at unit spacing 90,0.5,0.435,1,1,0.0075,-0.021,0.0265,-0.945 90,0.54,0.53,1,1,0.01,-0.99 33.6900576,0.5,0.49,1.386750443,0.277350338,0.036055516,-3.56949759 63.4349489,0.53,0.51,0.894427191,0.447213596,0.022360680,-2.213707298 123.6900675,0.54,0.54,1.386750491,0.277350098,0.036055512,-3.569495763 180,0.52,0.57,1,1,0.03,-0.97 225,0.49,0.57,0.707106781,0.707106781,0.03,-1.384213562
    1 point
  6. Try this (defun revlstp (lst p / nlst) (repeat p (setq nlst (cons (car lst) nlst) lst (cdr lst))) (reverse (append lst nlst)) )
    1 point
  7. Here is one way. (defun reverse:list (lst pos / lft run new lft out) (and (< pos (length lst)) (setq lft lst run -1 ) (repeat pos (setq new (cons (nth (setq run (1+ run)) lst) new) lft (cdr lft) ) ) (setq out (append (reverse new) (reverse lft))) ) out )
    1 point
  8. Did you read all the posts or stop at 1st.
    1 point
  9. yes, agree dealing with STRING, preferable eg: substr, strlen, vl-string- functions etc.. eval list hiccups = strcase all capital & blank ignored (defun c:tt (/ lst n $) (or (and (setq lst (read (strcat "(" (getstring t "\nInput value : ") ")"))) (setq n (length lst)) (mapcar '(lambda (a b) (setq $ (vl-princ-to-string b)) (princ (strcat "\n" a (cond ((and (listp b) (> n 2)) (substr $ 2 (- (strlen $) 2))) (t $) ) ) ) ) '( "Number : " "Text : ") (if (> n 2) (list (car lst) (cdr lst)) lst) ) ) (princ "\nNull input?") ) (princ) ) command: TT Input value : 123 df abc Number : 123 Text : DF ABC
    1 point
  10. Look at VL-FILE-COPY VL-FILE-DELETE VL-FILE-DIRECTORY-P VL-FILE-RENAME
    1 point
  11. For this "123 DF ABC" go back to maybe substr as soon as a space its not a number then whatever is left is a string. "123 DF ABC don't forget efg" (123 "DF ABC don't forget efg") ;convert number atof etc "123 DF ABC don't forget efg 54" (123 "DF ABC don't forget efg 54")
    1 point
  12. Also this and fixed 3 errors you had 2 brackets at end and wrong filename. (setq fname (STRCAT PATHF DWGNNNN "---" AAA ".TXT" ) "w") )
    1 point
  13. if you're wondering why it showing the error. ; error: bad argument type: stringp nil ... you mispelled one variable at your strcat statment and you are almost there..
    1 point
  14. continued... Obtain the knowledge by posting in CADTutor AutoLISP, Visual LISP & DCL At least put an effort to write a code and asked for advice / suggestions when you hit a wall. [ The best way to learn ] Search the forum for similar topic first before posting a request. Avoid starting a new topic when things does'nt go your way on an un-resolved issue from another topic that you started
    1 point
  15. Prompt the user for a string using the getstring function Obtain the path of the current drawing using the DWGPREFIX system variable Obtain the drawing filename using the DWGNAME system variable Obtain the value of these system variables using the getvar function Obtain the filename without the extension using the vl-filename-base function Concatenate the filepath, filename, "---", user string, and ".txt" extension using the strcat function Create the text file using the open function with the "w" argument (to open for writing) Close the text file using the close function
    1 point
  16. Well, what can I say... You can try this, but it's just a little buggus... Maybe someone will be able in future to implement it correctly... It was designed to work and with arced segments... (defun c:joinlws ( / *error* clockwise-p LM:Bulge->Arc LM:Arc->Bulge fls fas fle fae *adoc* ss fuzz i lw sp np pp ep sb pb l ll chain d nd dl dll s overkillA2012- qaf pea ) (vl-load-com) (defun *error* ( m ) (if qaf (setvar 'qaflags qaf) ) (if pea (setvar 'peditaccept pea) ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (defun clockwise-p ( p1 p p2 ) (minusp (- (* (car (mapcar '- p1 p)) (cadr (mapcar '- p2 p))) (* (cadr (mapcar '- p1 p)) (car (mapcar '- p2 p))))) ) ;; Bulge to Arc - Lee Mac - mod by M.R. ;; p1 - start vertex ;; p2 - end vertex ;; b - bulge ;; Returns: (<center> <start angle> <end angle> <radius>) (defun LM:Bulge->Arc ( p1 p2 b / a c r ) (setq a (* 2 (atan (abs b))) r (abs (/ (distance p1 p2) 2 (sin a))) c (if (minusp b) (polar p2 (+ (- (/ pi 2) a) (angle p2 p1)) r) (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)) ) (list c (angle c p1) (angle c p2) r) ) ;; Arc to Bulge - Lee Mac - mod by M.R. ;; c - center ;; a1,a2 - start, end angle ;; r - radius ;; lw - LWPOLYLINE ename ;; Returns: (<vertex> <bulge> <vertex>) (defun LM:Arc->Bulge ( c a1 a2 r lw / b flip ) (if (and (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a2 r)) 0.05)) (cdr (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a1 r)) 0.05)) (entget lw)))) (not (equal (setq b (cdr (assoc 42 (cdr (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a1 r)) 0.05)) (entget lw)))))) ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ) 1e-6)) ) (setq flip t) ) (list (polar c a1 r) (if (equal b (if flip (- (abs ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ) ) ) (abs ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ) ) ) 0.05) (if flip (- (abs ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ) ) ) (abs ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ) ) ) (if flip (- (abs ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a1 a2)) (+ pi pi)) 4.0) ) ) ) (abs ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a1 a2)) (+ pi pi)) 4.0) ) ) ) ) (polar c a2 r) ) ) (defun fls ( d l / lst1 lst2 ) (if (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadr x))) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadr x))) 1e-6))) l)) 1) (setq lst1 (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadr x))) 1e-6))) l)) (setq lst1 (vl-sort (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadr x))) 1e-6))) l) '(lambda ( a b ) (< (distance (cadr a) (cadr d)) (distance (cadr b) (cadr d)))))) ) (setq lst1 nil) ) (if (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadddr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadddr x))) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadddr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadddr x))) 1e-6))) l)) 1) (setq lst2 (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadddr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadddr x))) 1e-6))) l)) (setq lst2 (vl-sort (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadddr d) (cadddr x)) (+ (distance (cadddr d) (cadr d)) (distance (cadr d) (cadddr x))) 1e-6))) l) '(lambda ( a b ) (< (distance (cadddr a) (cadr d)) (distance (cadddr b) (cadr d)))))) ) (setq lst2 nil) ) (cond ( (and lst1 lst2) (if (< (distance (cadr (car lst1)) (cadr d)) (distance (cadddr (car lst2)) (cadr d))) (car lst1) (car lst2) ) ) ( (and lst1 (not lst2)) (car lst1) ) ( (and (not lst1) lst2) (car lst2) ) ( (and (not lst1) (not lst2)) nil ) ) ) (defun fas ( d l / lst1 lst2 ) (if (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) 1) (setq lst1 (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) (setq lst1 (vl-sort (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) '(lambda ( a b ) (< (rem (+ pi pi (- (cadr (LM:Bulge->Arc (cadr a) (cadddr d) (caddr d))) (caddr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)) (rem (+ pi pi (- (cadr (LM:Bulge->Arc (cadr b) (cadddr d) (caddr d))) (caddr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)))))) ) (setq lst1 nil) ) (if (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) 1) (setq lst2 (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) (setq lst2 (vl-sort (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) '(lambda ( a b ) (< (rem (+ pi pi (- (cadr (LM:Bulge->Arc (cadddr a) (cadddr d) (caddr d))) (caddr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)) (rem (+ pi pi (- (cadr (LM:Bulge->Arc (cadddr b) (cadddr d) (caddr d))) (caddr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)))))) ) (setq lst2 nil) ) (cond ( (and lst1 lst2) (if (< (rem (+ pi pi (- (cadr (LM:Bulge->Arc (cadr (car lst1)) (cadddr d) (caddr d))) (caddr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)) (rem (+ pi pi (- (cadr (LM:Bulge->Arc (cadddr (car lst2)) (cadddr d) (caddr d))) (caddr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi))) (car lst1) (car lst2) ) ) ( (and lst1 (not lst2)) (car lst1) ) ( (and (not lst1) lst2) (car lst2) ) ( (and (not lst1) (not lst2)) nil ) ) ) (defun fle ( d l / lst1 lst2 ) (if (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadr x))) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadr x))) 1e-6))) l)) 1) (setq lst1 (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadr x))) 1e-6))) l)) (setq lst1 (vl-sort (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadr x))) 1e-6))) l) '(lambda ( a b ) (< (distance (cadr a) (cadddr d)) (distance (cadr b) (cadddr d)))))) ) (setq lst1 nil) ) (if (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadddr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadddr x))) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadddr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadddr x))) 1e-6))) l)) 1) (setq lst2 (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadddr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadddr x))) 1e-6))) l)) (setq lst2 (vl-sort (vl-remove-if-not '(lambda ( x ) (and (zerop (caddr x)) (equal (distance (cadr d) (cadddr x)) (+ (distance (cadr d) (cadddr d)) (distance (cadddr d) (cadddr x))) 1e-6))) l) '(lambda ( a b ) (< (distance (cadddr a) (cadddr d)) (distance (cadddr b) (cadddr d)))))) ) (setq lst2 nil) ) (cond ( (and lst1 lst2) (if (< (distance (cadr (car lst1)) (cadr d)) (distance (cadddr (car lst2)) (cadr d))) (car lst1) (car lst2) ) ) ( (and lst1 (not lst2)) (car lst1) ) ( (and (not lst1) lst2) (car lst2) ) ( (and (not lst1) (not lst2)) nil ) ) ) (defun fae ( d l / lst1 lst2 ) (if (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) 1) (setq lst1 (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) (setq lst1 (vl-sort (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) '(lambda ( a b ) (< (rem (+ pi pi (- (caddr (LM:Bulge->Arc (cadr a) (cadddr d) (caddr d))) (cadr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)) (rem (+ pi pi (- (caddr (LM:Bulge->Arc (cadr b) (cadddr d) (caddr d))) (cadr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)))))) ) (setq lst1 nil) ) (if (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) (if (= (length (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) 1) (setq lst2 (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l)) (setq lst2 (vl-sort (vl-remove-if-not '(lambda ( x / *** ) (and (/= (caddr x) 0.0) (equal (distance (cadddr x) (car (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (cadddr ***) 1e-6))) l) '(lambda ( a b ) (< (rem (+ pi pi (- (caddr (LM:Bulge->Arc (cadddr a) (cadddr d) (caddr d))) (cadr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)) (rem (+ pi pi (- (caddr (LM:Bulge->Arc (cadddr b) (cadddr d) (caddr d))) (cadr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)))))) ) (setq lst2 nil) ) (cond ( (and lst1 lst2) (if (< (rem (+ pi pi (- (caddr (LM:Bulge->Arc (cadr (car lst1)) (cadddr d) (caddr d))) (cadr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi)) (rem (+ pi pi (- (caddr (LM:Bulge->Arc (cadddr (car lst2)) (cadddr d) (caddr d))) (cadr (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))))) (+ pi pi))) (car lst1) (car lst2) ) ) ( (and lst1 (not lst2)) (car lst1) ) ( (and (not lst1) lst2) (car lst2) ) ( (and (not lst1) (not lst2)) nil ) ) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (prompt "\nSelect open LWPOLYLINES to process...") (setq ss (ssget "_:L" (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 128) '(-4 . "or>")))) (initget 6) (setq fuzz (getdist "\nPick or specify fuzz gap distance between adjacent LWPOLYLINES <5e-3> : ")) (if (null fuzz) (setq fuzz 5e-3) ) (repeat (setq i (sslength ss)) (setq lw (ssname ss (setq i (1- i)))) (setq sp (trans (vlax-curve-getstartpoint lw) 0 1)) (setq np (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (setq pp (trans (vlax-curve-getpointatparam lw (1- (vlax-curve-getendparam lw))) 0 1)) (setq ep (trans (vlax-curve-getendpoint lw) 0 1)) (setq sb (vla-getbulge (vlax-ename->vla-object lw) 0.0)) (setq pb (vla-getbulge (vlax-ename->vla-object lw) (1- (vlax-curve-getendparam lw)))) (setq ll (cons (list (list t sp sb np) (list nil pp pb ep)) ll)) (setq l (cons (list t sp sb np) l) l (cons (list nil pp pb ep) l)) ) (defun chain ( d l ) (cond ( (eq (car d) t) (if (zerop (caddr d)) (setq nd (fls d l)) (setq nd (fas d l)) ) ) ( (null (car d)) (if (zerop (caddr d)) (setq nd (fle d l)) (setq nd (fae d l)) ) ) ) (cond ( (and nd (not (equal (cdr nd) (cdr d) 1e-) (null dl)) (setq dl (list d)) (setq dl (append dl (list nd))) ) ( (and nd (not (equal (cdr nd) (cdr d) 1e-) dl) (setq dl (append dl (list nd))) ) ) (if nd dl ) ) (foreach d l (foreach pair ll (if (or (equal d (car pair) 1e- (equal d (cadr pair) 1e-) (progn (setq dl (chain d (vl-remove (cadr pair) (vl-remove (car pair) l)))) (if dl (setq dll (cons (list pair dl) dll)) ) ) ) ) (setq dl nil) ) (setq s (ssadd)) (foreach dl dll (setq d (caadr dl) nd (cadadr dl)) (if (zerop (caddr d)) (cond ( (equal nd (fls d (vl-remove (cadar dl) (vl-remove (caar dl) l))) 1e- (ssadd (entmakex (list '(0 . "LINE") (cons 10 (if (equal (distance (cadr nd) (cadddr d)) (+ (distance (cadr nd) (cadr d)) (distance (cadr d) (cadddr d))) 1e-6) (trans (cadr nd) 1 0) (trans (cadddr nd) 1 0))) (cons 11 (trans (cadr d) 1 0)))) s) ) ( (equal nd (fle d (vl-remove (cadar dl) (vl-remove (caar dl) l))) 1e- (ssadd (entmakex (list '(0 . "LINE") (cons 10 (if (equal (distance (cadr nd) (cadr d)) (+ (distance (cadr nd) (cadddr d)) (distance (cadddr d) (cadr d))) 1e-6) (trans (cadr nd) 1 0) (trans (cadddr nd) 1 0))) (cons 11 (trans (cadddr d) 1 0)))) s) ) ) (cond ( (equal nd (fas d (vl-remove (cadar dl) (vl-remove (caar dl) l))) 1e- (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))) (if (< (distance (cadr d) (cadr nd)) (distance (cadr d) (cadddr nd))) (if (not (equal (cadr d) (cadr nd) 1e-6)) (if (not (clockwise-p (cadr d) (car ***) (cadr nd))) (command "_.ARC" "_non" (cadr d) "_C" "_non" (car ***) "_non" (cadr nd)) (command "_.ARC" "_non" (cadr nd) "_C" "_non" (car ***) "_non" (cadr d)) ) ) (if (not (equal (cadr d) (cadddr nd) 1e-6)) (if (not (clockwise-p (cadr d) (car ***) (cadddr nd))) (command "_.ARC" "_non" (cadr d) "_C" "_non" (car ***) "_non" (cadddr nd)) (command "_.ARC" "_non" (cadddr nd) "_C" "_non" (car ***) "_non" (cadr d)) ) ) ) (ssadd (entlast) s) ) ( (equal nd (fae d (vl-remove (cadar dl) (vl-remove (caar dl) l))) 1e- (setq *** (LM:Bulge->Arc (cadr d) (cadddr d) (caddr d))) (if (< (distance (cadddr d) (cadr nd)) (distance (cadddr d) (cadddr nd))) (if (not (equal (cadddr d) (cadr nd) 1e-6)) (if (not (clockwise-p (cadddr d) (car ***) (cadr nd))) (command "_.ARC" "_non" (cadddr d) "_C" "_non" (car ***) "_non" (cadr nd)) (command "_.ARC" "_non" (cadr nd) "_C" "_non" (car ***) "_non" (cadddr d)) ) ) (if (not (equal (cadddr d) (cadddr nd) 1e-6)) (if (not (clockwise-p (cadddr d) (car ***) (cadddr nd))) (command "_.ARC" "_non" (cadddr d) "_C" "_non" (car ***) "_non" (cadddr nd)) (command "_.ARC" "_non" (cadddr nd) "_C" "_non" (car ***) "_non" (cadddr d)) ) ) ) (ssadd (entlast) s) ) ) ) ) (setq qaf (getvar 'qaflags)) (setvar 'qaflags 1) (command "_.EXPLODE" ss) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq ss (ssget "_P")) (repeat (setq i (sslength s)) (ssadd (ssname s (setq i (1- i))) ss) ) (setq s ss) (defun overkillA2012- ( ss / lst ) (load "overkill.lsp") (acet-error-init (list '("cmdecho" 0) T ) ) (setq ss (car (acet-ss-filter (list ss nil T)))) (setq lst (list (max (acet-overkill-fuz-get) 1.0e-04) (acet-overkill-ignore-get) (acet-overkill-no-plines-get) (acet-overkill-no-partial-get) (acet-overkill-no-endtoend-get) ) ) (setq lst (cons ss lst)) (acet-overkill2 lst) (acet-error-restore) ) (if (< (atof (getvar 'acadver)) 18.2) (overkillA2012- ss) (progn (command "_.-OVERKILL" ss "" "_O" 1e-4 "_I" "_A" "_P" "_N" "_T" "_Y" "_E" "_Y" "") (while (< 0 (getvar 'cmdactive)) (command "") ) ) ) (repeat (setq i (sslength s)) (if (not (entget (ssname s (setq i (1- i))))) (ssdel (ssname s i) s) ) ) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1) (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" fuzz) (while (< 0 (getvar 'cmdactive)) (command "") ) (*error* nil) ) On attached file it didn't work as expected - perfectly... Sorry... M.R. [EDIT : Attached is lisp that should work fine for any 3D LWPOLYLINES orientations... Posted code should do it only for UCS aligned with selected LWPOLYLINES, but in lisp it's implemented also (overkill-MR) sub function that should take care of overlapping duplicates for sure...] joinlws.dwg joinlws.lsp
    1 point
  17. Both mapcar and foreach run from 1st to last. The major difference between the 2 is what's known in programming parlance as functional and procedural. In both the list is processes one item at a time starting from the 1st. The differences are: With mapcar a function is applied to each item in turn, and then a new list containing the modified results is what comes out. With foreach multiple statements are run with the current item in its nth state. No new list is (necessarily) returned or created - normally only the very last calculation is returned at the end of foreach. Think of it as such: When you want to modify each item in a list and get a resulting list - mapcar is most probably your choice. If you want to use the list to modify something else foreach is probably best. This does not mean that you use foreach when making a procedural (also called imperative) and mapcar when you're making a functional thing. You can easily alter the result and set variables states in either one. Thus what you do inside each can have similar effects, but on their own they're quite distinct. E.g. let's say you've got a list of integers want to add 10 to each: (mapcar '(lambda (item) (+ item 10)) '(1 2 3 4 5)) ;Result is (11 12 13 14 15) To get the same using foreach: (setq result nil) (foreach item '(1 2 3 4 5) (setq result (cons (+ item 10) result) ) ;Last call to setq returns (15 14 13 12 11) because the cons adds the new item in front (reverse result) ;So reverse the list to get (11 12 13 14 15) Now let's say we want to sum each value together to get a grand total: (setq total 0) (mapcar '(lambda (item) (setq total (+ total item))) '(1 2 3 4 5)) ;; Result of mapcar would be (1 3 6 10 15) (princ total) ;Total's value becomes 15 Here it's probably more in-line with using foreach: (setq total 0) (foreach item '(1 2 3 4 5) (setq total (+ total item)) ) ;The result at the end is 15, as is the value inside total. Or slightly off topic: to use a pure functional way: (apply '+ '(1 2 3 4 5)) ;Result is 15
    1 point
×
×
  • Create New...