(defun c:lc () (setvar "cmdecho" 1) (setq gg 1.0e-8) (setq dst nil) (setq os (getvar "osmode")) (setvar "osmode" 0) (prompt "\n ") (prompt "\n ") (setq dst (getreal "\nEnter Distance: <4.0> ")) (if (= dst nil) (setq dst 4.0) ) (setq dst (abs dst)) (setq dt (/ dst 2.0)) (setq as1 nil) (setq as2 (ssadd)) (setq as3 nil) (setq lx1 nil) (setq cc (getvar "cecolor")) (setq cl (getvar "celtype")) (setq cy (getvar "clayer")) (prompt "\n ") (prompt "\n ") (prompt "\n> > > M A I N - L I N E S ") (setq as1 (ssget '((0 . "LINE")))) (if (/= as1 nil) (progn (setq ls1 (sslength as1)) (setq nn1 -1) (repeat ls1 (setq nn1 (+ nn1 1)) (setq e1 (ssname as1 nn1)) (setq le1 (entget e1)) (setq llex1 (cdr (assoc 62 le1))) (setq lx1 (append lx1 (list (list llex1)))) (command "_chprop" e1 "" "_color" "1" "") ) (prompt "\n ") (prompt "\n ") (prompt "\n> > > C R O S S - L I N E S ") (setq as3 (ssget '((0 . "LINE")))) (setq nn1 -1) (repeat ls1 (setq nn1 (+ nn1 1)) (setq e1 (ssname as1 nn1)) (setq llex1 (car (nth nn1 lx1))) (if (/= llex1 nil) (command "_chprop" e1 "" "_color" llex1 "") (command "_chprop" e1 "" "_color" "BYLAYER" "") ) ) (if (/= as3 nil) (progn (setq ls3 (sslength as3)) (setq nn1 -1) (repeat ls3 (setq nn1 (+ nn1 1)) (setq e3 (ssname as3 nn1)) (setq asx3 (ssmemb e3 as1)) (if (= asx3 nil) (ssadd e3 as2) ) ) (if (/= as2 nil) (progn (setq ls2 (sslength as2)) (setq lls2 -1) (repeat ls2 (setq lls2 (+ lls2 1)) (setq e2 (ssname as2 lls2)) (setq le2 (entget e2)) (setq lx1 (cdr (assoc 62 le2))) (if (/= lx1 nil) (setq lx1 (itoa lx1)) ) (setq lx2 (cdr (assoc 8 le2))) (setq lx3 (cdr (assoc 6 le2))) (setq p1 (cdr (assoc 10 le2))) (setq p2 (cdr (assoc 11 le2))) (setq al1 (angle p1 p2)) (setq dxx (distance p1 p2)) (setq pxx (polar p2 al1 dt)) (setq dxx1 (distance p1 pxx)) (if (> dxx1 dxx) (setq al1 (+ al1 pi)) ) (setq al3 (+ al1 pi)) (setq ps nil) (setq pe nil) (setq ds nil) (setq de nil) (setq ps (append ps (list p1))) (setq ds (append ds (list (list 0.0)))) (setq nn 1) (setq lls1 -1) (repeat ls1 (setq lls1 (+ lls1 1)) (setq e1 (ssname as1 lls1)) (setq le1 (entget e1)) (setq p3 (cdr (assoc 10 le1))) (setq p4 (cdr (assoc 11 le1))) (setq p (inters p1 p2 p3 p4)) (if (/= p nil) (progn (setq dxx (distance p p1)) (setq dxx1 (distance p p2)) (if (> dxx dxx1) (setq dxx dxx1)) (setq dxx1 (distance p p3)) ;------------- (if (> dxx dxx1) (setq dxx dxx1)) (setq dxx1 (distance p p4)) ;------------- (if (> dxx dxx1) (setq dxx dxx1)) (if (> dxx gg) (progn (setq al2 (angle p3 p4)) (setq al (- al1 al2)) (setq dtt (/ dt (sin al))) (setq dtt (abs dtt)) (setq dxx (distance p p1)) (if (< dxx (* dtt 2.0)) (progn (setq px (polar p al1 (/ dxx 2.0))) (setq de (append de (list (list (/ dxx 2.0))))) (setq pe (append pe (list px))) ) (progn (setq px (polar p al1 dtt)) (setq de (append de (list (list (distance p1 px))))) (setq pe (append pe (list px))) ) ) (setq dxx (distance p p2)) (if (< dxx (* dtt 2.0)) (progn (setq px (polar p al3 (/ dxx 2.0))) (setq ds (append ds (list (list (distance p1 px))))) (setq ps (append ps (list px))) ) (progn (setq px (polar p al3 dtt)) (setq ds (append ds (list (list (distance p1 px))))) (setq ps (append ps (list px))) ) ) (setq nn (+ nn 1)) ) ) ) ) ) (setq pe (append pe (list p2))) (setq de (append de (list (list (distance p1 p2))))) (if (> nn 1) (progn ; ; S o r t i e r e n S t a r t p u n k t e ; (setq lp ps) (setq lp1 ds) (setq nn1 nn) (setq lq1 lp1) (setq lq1p lp) (setq ls nil) (setq lsp nil) (repeat (- nn 1) (setq lp1 lq1) (setq lp lq1p) (setq lq (car (nth 0 lp1))) (setq lqp (nth 0 lp)) (setq nn1 (- nn1 1)) (setq nn2 0) (setq lq1 nil) (setq lq1p nil) (repeat nn1 (setq nn2 (+ nn2 1)) (setq lr (car (nth nn2 lp1))) (setq lrp (nth nn2 lp)) (if (< lr lq) (progn (setq lq1 (append lq1 (list (list lq)))) (setq lq1p (append lq1p (list lqp))) (setq lr1 lr) (setq lr1p lrp) (setq lr lq) (setq lrp lqp) (setq lq lr1) (setq lqp lr1p) ) (progn (setq lq1 (append lq1 (list (list lr)))) (setq lq1p (append lq1p (list lrp))) ) ) ) (setq ls (append ls (list (list lq)))) (setq lsp (append lsp (list lqp))) ) (setq ls (append ls lq1)) (setq lsp (append lsp lq1p)) (setq ps lsp) (setq ds ls) ; ; E n d e S o r t i e r u n g S t a r t p u n k t e ; ; ; S o r t i e r e n E n d p u n k t e ; (setq lp pe) (setq lp1 de) (setq nn1 nn) (setq lq1 lp1) (setq lq1p lp) (setq ls nil) (setq lsp nil) (repeat (- nn 1) (setq lp1 lq1) (setq lp lq1p) (setq lq (car (nth 0 lp1))) (setq lqp (nth 0 lp)) (setq nn1 (- nn1 1)) (setq nn2 0) (setq lq1 nil) (setq lq1p nil) (repeat nn1 (setq nn2 (+ nn2 1)) (setq lr (car (nth nn2 lp1))) (setq lrp (nth nn2 lp)) (if (< lr lq) (progn (setq lq1 (append lq1 (list (list lq)))) (setq lq1p (append lq1p (list lqp))) (setq lr1 lr) (setq lr1p lrp) (setq lr lq) (setq lrp lqp) (setq lq lr1) (setq lqp lr1p) ) (progn (setq lq1 (append lq1 (list (list lr)))) (setq lq1p (append lq1p (list lrp))) ) ) ) (setq ls (append ls (list (list lq)))) (setq lsp (append lsp (list lqp))) ) (setq ls (append ls lq1)) (setq lsp (append lsp lq1p)) (setq pe lsp) (setq de ls) ; ; E n d e S o r t i e r u n g E n d p u n k t e ; (setvar "clayer" lx2) (if (/= lx1 nil) (setvar "cecolor" lx1) (setvar "cecolor" "BYLAYER") ) (if (/= lx3 nil) (setvar "celtype" lx3) (setvar "celtype" "BYLAYER") ) (setq nn1 -1) (entdel e2) (repeat nn (setq nn1 (+ nn1 1)) (setq dd (car (nth nn1 ds))) (setq dd1 (car (nth nn1 de))) (if (< dd dd1) (progn (setq pp (nth nn1 ps)) (setq pp1 (nth nn1 pe)) (command "_line" pp pp1 "") ) ) ) ) ) ) ) ) ) ) ) ) (setvar "clayer" cy) (setvar "cecolor" cc) (setvar "celtype" cl) (setvar "cmdecho" 1) (command "osmode" os) )