Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/13/2020 in all areas

  1. Thanks Hosneyalaa now its working perfect.
    1 point
  2. Buddy, you could be missing some of the great fun that people been posting. You can thank @Trudy for this:
    1 point
  3. It is possible can offset the rectangs and check what do they touch which if dwg is 100% correct would be the green *lines. (defun c:test ( / ) (setq olsnap (getvar 'Osmode)) (While (setq obj1 (entsel"\nPick rectangle Enter to exit ")) (setvar 'osmode 0) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car obj1))))) (setq pt (getvar 'extmax)) (setq pt (list (car pt)(cadr pt))) (command "offset" 200 obj1 pt "") (setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast))))) (setq co-ord2 (cons (last co-ord2) co-ord2)) (command "erase" (entlast) "") (setq obj2 (vlax-ename->vla-object (ssname (ssget "F" co-ord2 (list (cons 0 "*LINE"))) 0))) (setq end (vlax-curve-getendpoint obj2)) (setq start (vlax-curve-getstartpoint obj2)) (if (> (distance (nth 0 co-ord) start) (distance (nth 0 co-ord) end)) (command "point" start) (command "point" end) ) (setvar 'pdmode 35) ) (setvar 'osmode oldsnap) (princ) )
    1 point
  4. ;; ss - the selection set of rectangles ;; lns - the selection set of lines ;; tol - intersection tolerance (defun furthestpt (ss lns tol / ent ep i rtn ssl sp) (repeat (setq i (sslength ss)) (setq i (1- i) ssl (cons (ssname ss i) ssl)) ) (repeat (setq i (sslength lns)) (setq i (1- i) ent (ssname lns i) sp (vlax-curve-getStartPoint ent) ep (vlax-curve-getEndPoint ent) rtn (cons (vl-some '(lambda (x) (cond ((equal sp (vlax-curve-getClosestPointTo x sp) tol) ep) ((equal ep (vlax-curve-getClosestPointTo x sp) tol) sp) ) ) ssl ) rtn ) ) ) (reverse rtn) ) (defun c:test nil (furthestpt (ssget "_X" '((0 . "LWPOLYLINE") (62 . 1) (410 . "Model"))) (ssget "_X" '((0 . "LWPOLYLINE") (62 . 3) (410 . "Model"))) 1e-6 ) )
    1 point
  5. (Defun foot (lst / a b c d e f x nlst) (While (setq a (Car lst)) (setq x (Cdr lst)) (setq b (reverse a) c (Car b) d (cdr b) ) (while (setq e (car x)) (if (equal (cdr (reverse e)) d) (setq c (+ (last e) c)) (setq g (cons e g)) ) (setq x (cdr x)) ) (setq nlst (cons (append d (list c)) nlst) lst g g nil ) ) nlst ) Test (setq lst '((1 1 1 1 3) (2 2 2 2 3) (1 1 1 1 4))) _$ (foot lst) ((1 1 1 1 7) (2 2 2 2 3)) _$ (foo lst) ((1 1 1 1 7) (2 2 2 2 3)) _$ (F:S lst) ((1 1 1 1 7) (2 2 2 2 3)) _$ (F:G lst) ((1 1 1 1 7) (2 2 2 2 3)) _$ (setq lst '((1 1 1 1 3) (2 2 2 2 2 3) (1 1 1 1 4) (1 1 1 1 1 4)(2 2 2 2 2 7))) ((1 1 1 1 3) (2 2 2 2 2 3) (1 1 1 1 4) (1 1 1 1 1 4) (2 2 2 2 2 7)) _$ (foot lst) ((1 1 1 1 7) (2 2 2 2 2 10) (1 1 1 1 1 4)) _$ (foo lst) ((1 1 1 1 7) (2 2 2 2 2 10) (1 1 1 1 1 4)) _$ (F:S lst) ((1 1 1 1 8) (2 2 2 2 4)) _$ (F:G lst) ((1 1 1 1 7) (2 2 2 2 2 10) (1 1 1 1 1 4))
    1 point
×
×
  • Create New...