0 Members and 1 Guest are viewing this topic.
Serious Support !H/V connections is easy to get , just help yourself .
;;; function : to union rectangulars with a given span range;;; the span(dis) must be a number which can connect wanted rects and don't connect rects you do not want .;;; so it's just a way for example , to suit for all conds you must take the span [from ~ to] into recursion .;;; by GSLS(SS) 2011-4-12;;; (defun c:test (/ dis ss ssobj doc ms os ob a b pda) (or dis (setq dis (getreal "\nPlease input joined max-distance<25>:")) (setq dis 25.) ) ;_here is just a way , it must be [from ~ to] to check is suit for . (setq ssobj (ss2lst (ssget '((0 . "LWPOLYLINE"))) T)) (setq os (getvar "OSMODE")) (setvar "OSMODE" 0) (setq doc (vla-get-activedocument (vlax-get-acad-object) ) ms (vla-get-modelspace doc) ob nil ss (ssadd) ) (foreach a ssobj (setq b (ss-Offset a (- dis))) (if (not (vl-catch-all-error-p b)) (progn (setq b (car (vlax-safearray->list (vlax-variant-value b ) ) ) ) (vla-addregion ms (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 0)) (list b) ) ) (if (vlax-erased-p b) nil (vla-delete b) ) (setq ss (ssadd (entlast) ss)) ) ) ) (command "union" ss "") (command "explode" (entlast)) (setq ss (ssget "p")) (vl-catch-all-apply (quote (lambda nil (if (setq pda (getvar "peditaccept")) (progn (setvar "peditaccept" 1) (command "_pedit" "m" ss "" "j" "j" "b" 1e-6 "") (setvar "peditaccept" pda) ) (command "_pedit" "m" ss "" "y" "j" "j" "b" 1e-6 "") ) ) ) ) (ss-Offset (setq b (vlax-ename->vla-object (entlast))) dis) (vla-delete b) (setvar "OSMODE" os) (princ));;;;(defun ss-Offset (obj d / b p ret) (cond ((= "16" (substr (getvar "acadver") 1 2)) (setq p (vlax-3D-point (vlax-curve-getstartpoint obj))) (vla-move obj p (vlax-3D-point (list 0 0 0))) (setq ret (VL-CATCH-ALL-APPLY (quote vla-Offset) (list obj d))) (vla-move obj (vlax-3D-point (list 0 0 0)) p) (if (not (vl-catch-all-error-p ret)) (vla-move (car (vlax-safearray->list (vlax-variant-value ret))) (vlax-3D-point (list 0 0 0)) p ) ) ret ) (t (VL-CATCH-ALL-APPLY (quote vla-Offset) (list obj d)) ) ))(defun ss2lst (ss vla / a e i) (setq i -1) (while (setq e (ssname ss (setq i (1+ i)))) (if vla (setq e (vlax-ename->vla-object e)) ) (setq a (cons e a)) ))
Keep watching...
Quote from: xiaxiang on April 11, 2011, 04:11:56 AMKeep watching...It's your homework , not mines . so don't keep wathching ... get over by yourself until your 'Need your help' .
;;==========================================================;; Original from Gile;; modification from chlh_jd(defun c:test1 (/ dist n ss ent lst pt p Minpt Maxpt pt1 ssad1 reg ss2 pda) (setq dist (getdist "\nMax distance :") ssadd1 nil reg nil ss2 nil) (if (setq n -1 ;;ss (ssget '((0 . "POINT")));_==>> extracted from polylines ss (ssget '((0 . "LWPOLYLINE"))) ) (while (setq ent (ssname ss (setq n (1+ n)))) (setq lst (append (polycoords ent) lst)) ) ) (setq ssad1 (ssadd)) (while lst (setq pt (car lst) lst (cdr lst) ) (foreach p lst (if (and (<= (distance pt p) dist) (/= (distance pt p) 0.00) (or (equal (MeCalcTheta pt p) 90.0) (equal (MeCalcTheta pt p) 0.0) (equal (MeCalcTheta pt p) 180.0) (equal (MeCalcTheta pt p) 270.0) ) ) (progn (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 p))) (ssadd (entlast) ssad1)) ) ) );_end while (vl-cmdf "region" ssad1 "") (princ "SELECT AGAIN ") (setq reg (ssget '((0 . "REGION"))));_==> i'm sure there's another better way (vl-cmdf "erase" ssad1 "") (vl-cmdf "union" reg "") (command "explode" (entlast)) (setq ss2 (ssget "p")) (vl-catch-all-apply (quote (lambda nil (if (setq pda (getvar "peditaccept")) (progn (setvar "peditaccept" 1) (command "_pedit" "m" ss2 "" "j" "j" "b" 1e-6 "") (setvar "peditaccept" pda) ) (command "_pedit" "m" ss2 "" "y" "j" "j" "b" 1e-6 "") ) ) ) ));_defun;; Jurg menzi(defun MeCalcTheta (Pt1 Pt2 / X__Abs Y__Abs X__Dif Y__Dif TheVal) (setq X__Dif (- (car Pt2) (car Pt1)) Y__Dif (- (cadr Pt2) (cadr Pt1)) X__Abs (abs X__Dif) Y__Abs (abs Y__Dif) TheVal (if (equal (+ X__Abs Y__Abs) 0.0 1E-8) 0.0 (/ Y__Dif (+ X__Abs Y__Abs)) ) ) (if (< X__Dif 0) (setq TheVal (- 2.0 TheVal)) (if (< Y__Dif 0) (setq TheVal (+ 4.0 TheVal))) ) (* 90.0 TheVal));; Get coordinate ;; using vlax-curve* functions. ;; Works with all curve polylines types (lw, 2d, 3d) returns WCS coordinates.;; Gile;; http://www.cadtutor.net/forum/showthread.php?51700-Vertices-of-a-Polyline(defun polyCoords (pl / n l) (vl-load-com) (setq pl (vlax-ename->vla-object pl)) (setq n (if (vlax-curve-IsClosed pl) (fix (vlax-curve-getEndParam pl)) (1+ (fix (vlax-curve-getEndParam pl))) ) ) (while (/= 0 n) (setq l (cons (vlax-curve-getPointAtParam pl (setq n (1- n))) l)) ))
i'm still learning (and lurking.. ) vlisp.m4rdy
Hi,m4rdyIt works. But surplus region has not been deleted.BTW,I will show my code this afternoon.
And how can I decide the max distance in your code?