pmadhwal7 Posted September 3, 2019 Share Posted September 3, 2019 Dear All sir, can any body write a lsp routine of break line symbol which will draw break line symbol in multiple polyline at once. Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 3, 2019 Share Posted September 3, 2019 How do I know where to draw the break? You should still select a point for every polyline. Or do you have another solution in mind? Quote Link to comment Share on other sites More sharing options...
tombu Posted September 3, 2019 Share Posted September 3, 2019 ;|======================================================= Draw Line with Breakline Symbol to Dimscale Updated 6/2018 Replacement for BREAKLINE (Express Tool) that works in any direction and scales to Annotation Scale. BrkLnSym Breaks lines and inserts break-line symbol ^C^C^P(or C:BrkLnSym (load "BrkLnSym.lsp"));BrkLnSym Brkline5k-oie.png (load "BrkLnSym.lsp") BrkLnSym ; =======================================================|; (defun c:BrkLnSym (/ *error* p1 p2 p3 p4 p5) (setq vars (mapcar '(lambda (x) (cons x (getvar x))) '("osmode" "nomutt"))) (defun *error* (msg) ;; Reset variables (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) (grtext -1 "") ;CLEAR STATUS LINE (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) (princ) ) ) (setvar 'osmode 512) (cond ((= 1 (getvar "cvport"))(setq InsScale 0.1)) ((= 1 (getvar "TILEMODE"))(setq InsScale (/ 0.1 (getvar 'cannoscalevalue)))) (T(setq InsScale (caddr (trans '(0 0 0.1) 3 2)))) ) (setq p3 (getpoint "\nBreak Point: ") ss (ssget p3) obj (vlax-ename->vla-object (ssname ss 0)) ang (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj p3))) p1 (polar p3 ang InsScale) p2 (polar p3 (+ (/ pi 3) ang) InsScale) p4 (polar p3 (+ (/ pi 3) (- ang pi)) InsScale) p5 (polar p3 (- ang pi) InsScale) ) (setvar "nomutt" 1) (command "_break" ss p1 p5 "pline" p1 p2 p3 p4 p5 "") (entupd (ssname ss 0)) (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) (princ) ) Should get you started, scaled to current Annotation Scale at picked point. Icon with transparent background attached. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 4, 2019 Share Posted September 4, 2019 (edited) A suggestion when you get point and select object put its entity name to a list, when you break get (entlast) add the 3 lines put entity names to list you can use join to make back into a pline with a zig/zag. Tombu code did not work ? Something to do with cannoscale maybe. How long a line or pline segment ? Set cannoscale to 1:x ? Changed dimscale etc etc Command: BRKLNSYM Break Point: ; error: bad argument type: numberp: nil I usually just ask for break distance and offset. Old fashioned answer to draw between 2 points. zigzag.LSP Edited September 4, 2019 by BIGAL Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 4, 2019 Share Posted September 4, 2019 (edited) If they are basicaly in some form of sequence can be done. Drag a line/pline over at point of break. Like Emmanuel an image or dwg required. Edited September 4, 2019 by BIGAL Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 4, 2019 Author Share Posted September 4, 2019 please check my attached dwg brk line.dwg Quote Link to comment Share on other sites More sharing options...
tombu Posted September 4, 2019 Share Posted September 4, 2019 4 hours ago, BIGAL said: Tombu code did not work ? Something to do with cannoscale maybe. How long a line or pline segment ? Set cannoscale to 1:x ? Changed dimscale etc etc Command: BRKLNSYM Break Point: ; error: bad argument type: numberp: nil It's designed to place the breakline symbol on an existing line, polyline or arc. You have to pick one of those same as with the BREAKLINE (Express Tool), guess I need to add error checking. The breaklines display the same in Paper Space as they do inside a Viewport using the CANNOSCALEVALUE value (not CANNOSCALE) unless you change the Annotation Scale afterwards. Quote Link to comment Share on other sites More sharing options...
tombu Posted September 4, 2019 Share Posted September 4, 2019 1 hour ago, pmadhwal7 said: please check my attached dwg Without a Layout with a Viewport it doesn't appear you're using Annotation Scale, but setting the Annotation Scale to 1:5 seemed to work. As I'm not familiar with Metric drawings or plotting from Model Space that's the best I can offer. Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 5, 2019 Share Posted September 5, 2019 23 hours ago, pmadhwal7 said: please check my attached dwg brk line.dwg 217.06 kB · 6 downloads Ah, I see. Then this should work. - Set as current layer the layer of the breaklines - Command MBL (for Make Break Lines, see bottom function) - Select the blue polylines. (I attached a dwg containing only the blue polylines, for testing) (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; Get polyline coordinates ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun c:mbl ( / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first ;; extract its points (setq lst (vlax-get pline1 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline1)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps1 (nth 0 pts)) (setq pe1 (last pts)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) ;; extract its points (setq lst (vlax-get pline2 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline2)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps2 (nth 0 pts)) (setq pe2 (last pts)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl 1.0 (angle ps1 mps) ps1 mps 0.18) 0 ) ) (setq pl (drawLWPoly (bl 1.0 (angle pe1 mpe) pe1 mpe 0.18) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) breaklines.dwg Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 6, 2019 Share Posted September 6, 2019 (edited) Emmanuel a suggestion rather than pick p1p2 drag a line over the two plines near an end what this allows you to do is to compare the two plines and if required swap the start and end pts so both plines are considered in same direction as your doing already pt1 ->endpoint ->startpoint. A little operator easier you can use (ssget "F" (list pt1 pt2) ) …… removes osnap problems and gets you to the two plines. Add a while so can repeat. Could do pick pline and get layer so other objects are not considered in ssget. The start and end using vl is a function no need for co-ordinates. Note does not work on lines. (setq stpt (vlax-curve-getstartpoint obj)) ; (25867.7091634096 55028.4440727107 0.0) (setq endpt (vlax-curve-getendpoint obj)) ; (25929.6833934434 55030.1799066927 0.0) You need also to add drawpoly defun its missing we all do that forget something that's needed. Maybe this also so not hard coded run only once before while then others can use with different values. (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values" "Gap " 5 4 "1" "Angle" 5 4 "70" "Extend" 5 4 "0.2" ))) returns a list ("1" "70" "0.2") Edited September 7, 2019 by BIGAL 1 Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 6, 2019 Author Share Posted September 6, 2019 16 hours ago, Emmanuel Delay said: Ah, I see. Then this should work. - Set as current layer the layer of the breaklines - Command MBL (for Make Break Lines, see bottom function) - Select the blue polylines. (I attached a dwg containing only the blue polylines, for testing) (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; Get polyline coordinates ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun c:mbl ( / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first ;; extract its points (setq lst (vlax-get pline1 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline1)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps1 (nth 0 pts)) (setq pe1 (last pts)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) ;; extract its points (setq lst (vlax-get pline2 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline2)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps2 (nth 0 pts)) (setq pe2 (last pts)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl 1.0 (angle ps1 mps) ps1 mps 0.18) 0 ) ) (setq pl (drawLWPoly (bl 1.0 (angle pe1 mpe) pe1 mpe 0.18) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) breaklines.dwg 55.98 kB · 1 download ; error: no function definition: DRAWLWPOLY Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 6, 2019 Share Posted September 6, 2019 (edited) Oops sorry, I didn't copy/paste all the code. EDIT: use this code on top, I shortened it, using one of BIGAL's suggestion (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun mbl (ext gap / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first (setq ps1 (vlax-curve-getstartpoint pline1)) (setq pe1 (vlax-curve-getendpoint pline1)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) (setq ps2 (vlax-curve-getstartpoint pline2)) (setq pe2 (vlax-curve-getendpoint pline2)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl gap (angle ps1 mps) ps1 mps ext) 0 ) ) (setq pl (drawLWPoly (bl gap (angle pe1 mpe) pe1 mpe ext) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) (defun c:mbl ( / ext gap ) ;; settings, feel free to change these numbers (setq ext 0.18) (setq gap 1.0) ;; invoke the main function (mbl ext gap) (princ) ) old code (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; Get polyline coordinates ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun c:mbl ( / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first ;; extract its points (setq lst (vlax-get pline1 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline1)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps1 (nth 0 pts)) (setq pe1 (last pts)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) ;; extract its points (setq lst (vlax-get pline2 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline2)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps2 (nth 0 pts)) (setq pe2 (last pts)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl 1.0 (angle ps1 mps) ps1 mps 0.18) 0 ) ) (setq pl (drawLWPoly (bl 1.0 (angle pe1 mpe) pe1 mpe 0.18) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) Edited September 6, 2019 by Emmanuel Delay Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 6, 2019 Author Share Posted September 6, 2019 2 hours ago, Emmanuel Delay said: Oops sorry, I didn't copy/paste all the code. EDIT: use this code on top, I shortened it, using one of BIGAL's suggestion (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun mbl (ext gap / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first (setq ps1 (vlax-curve-getstartpoint pline1)) (setq pe1 (vlax-curve-getendpoint pline1)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) (setq ps2 (vlax-curve-getstartpoint pline2)) (setq pe2 (vlax-curve-getendpoint pline2)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl gap (angle ps1 mps) ps1 mps ext) 0 ) ) (setq pl (drawLWPoly (bl gap (angle pe1 mpe) pe1 mpe ext) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) (defun c:mbl ( / ext gap ) ;; settings, feel free to change these numbers (setq ext 0.18) (setq gap 1.0) ;; invoke the main function (mbl ext gap) (princ) ) old code (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; Get polyline coordinates ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun c:mbl ( / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first ;; extract its points (setq lst (vlax-get pline1 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline1)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps1 (nth 0 pts)) (setq pe1 (last pts)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) ;; extract its points (setq lst (vlax-get pline2 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline2)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps2 (nth 0 pts)) (setq pe2 (last pts)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl 1.0 (angle ps1 mps) ps1 mps 0.18) 0 ) ) (setq pl (drawLWPoly (bl 1.0 (angle pe1 mpe) pe1 mpe 0.18) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) Wow great thanks sir it will save my lots of time....many thanks 1 Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 6, 2019 Author Share Posted September 6, 2019 3 hours ago, Emmanuel Delay said: Oops sorry, I didn't copy/paste all the code. EDIT: use this code on top, I shortened it, using one of BIGAL's suggestion (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun mbl (ext gap / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first (setq ps1 (vlax-curve-getstartpoint pline1)) (setq pe1 (vlax-curve-getendpoint pline1)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) (setq ps2 (vlax-curve-getstartpoint pline2)) (setq pe2 (vlax-curve-getendpoint pline2)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl gap (angle ps1 mps) ps1 mps ext) 0 ) ) (setq pl (drawLWPoly (bl gap (angle pe1 mpe) pe1 mpe ext) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) (defun c:mbl ( / ext gap ) ;; settings, feel free to change these numbers (setq ext 0.18) (setq gap 1.0) ;; invoke the main function (mbl ext gap) (princ) ) old code (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe (defun bl (gap ang ps pe ext / pm p1 p2 p3 p4) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; Get polyline coordinates ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun c:mbl ( / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe lst pts pl) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first ;; extract its points (setq lst (vlax-get pline1 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline1)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps1 (nth 0 pts)) (setq pe1 (last pts)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) ;; extract its points (setq lst (vlax-get pline2 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName pline2)) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) ;; start point & end point: (setq ps2 (nth 0 pts)) (setq pe2 (last pts)) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl 1.0 (angle ps1 mps) ps1 mps 0.18) 0 ) ) (setq pl (drawLWPoly (bl 1.0 (angle pe1 mpe) pe1 mpe 0.18) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) Sir i have one query can u help me???? Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 6, 2019 Share Posted September 6, 2019 Sure, what? Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 6, 2019 Author Share Posted September 6, 2019 48 minutes ago, Emmanuel Delay said: Sure, what? actually i also want to put this symbol in my scale bar as you see in my dwg i also mark break-line in bottom of blue line, so is it possible this lsp work on those lines too.....?? Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 6, 2019 Share Posted September 6, 2019 Yeah, that's a bit different. It's all vertical, rounded up to the next number on the scale (2 units apart), extended 0.5 units. But the buttom polylines are all drawn from right to left, the top ones from from left to right. That messes with my algorithm, I'll have to add some code. You may have tried my code on there and noticed it's completely not what you want there. I'm not sure if I can do this this afternoon, I may need some time for it. Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 6, 2019 Author Share Posted September 6, 2019 6 minutes ago, Emmanuel Delay said: Yeah, that's a bit different. It's all vertical, rounded up to the next number on the scale (2 units apart), extended 0.5 units. But the buttom polylines are all drawn from right to left, the top ones from from left to right. That messes with my algorithm, I'll have to add some code. You may have tried my code on there and noticed it's completely not what you want there. I'm not sure if I can do this this afternoon, I may need some time for it. ok sir thank you very very much.... for all Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 6, 2019 Share Posted September 6, 2019 Okay, I have mbl for the blue lines, msbl for the red lines. The olny thing: it doesn't extend the left break line to the same height as the right break line necessarily, I hope that's okay (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; http://www.lee-mac.com/round.html ;; Round Up - Lee Mac ;; Rounds 'n' up to the nearest 'm' (defun LM:roundup ( n m ) ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe ;; roundup: if set -> make sure the line is extended (not counting th extensions) to a multiple of the roundup value. ;; Example: if the line is 12.3 and roundup is 2.0 the line grows to 14.0 (again, not counting the extensions) ;; bottom coordinate stays the same, top coordinate extends ;; This should only happen if the line is vertical (defun bl (gap ang ps pe ext roundup / pm p1 p2 p3 p4 newlength) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (if roundup (progn ;; check which is up (setq newlength (LM:roundup (distance ps pe) roundup)) ;; check which is up (if (< (nth 1 ps) (nth 1 pe)) ;; ps is bottom (setq pe (list (nth 0 pe) (+ (nth 1 ps) newlength))) ;; pe is bottom (setq ps (list (nth 0 ps) (+ (nth 1 pe) newlength))) ) )) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18 nil) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun mbl (ext gap roundup / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe pl ptemp) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first (setq ps1 (vlax-curve-getstartpoint pline1)) (setq pe1 (vlax-curve-getendpoint pline1)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) (setq ps2 (vlax-curve-getstartpoint pline2)) (setq pe2 (vlax-curve-getendpoint pline2)) ;; in case endpoint and startpoint are reversed (top pline is drawn from left to right, bottom line is drawn from right to left), we may have to swap ps2/pe2 (if (< (distance ps1 pe2 ) (distance ps1 ps2 ) ) (progn ;; swap. (setq ptemp pe2) (setq pe2 ps2) (setq ps2 ptemp) )) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl gap (angle ps1 mps) ps1 mps ext roundup) 0 ) ) (setq pl (drawLWPoly (bl gap (angle pe1 mpe) pe1 mpe ext roundup) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) (defun c:mbl ( / ext gap ) ;; settings, feel free to change these numbers (setq ext 0.18) (setq gap 1.0) ;; invoke the main function (mbl ext gap nil) (princ) ) ;; make Scale Break Lines (defun c:msbl ( / ext gap roundup) ;; settings, feel free to change these numbers (setq ext 0.5) (setq gap 1.0) (setq roundup 2.0) ;; invoke the main function (mbl ext gap roundup) (princ) ) Quote Link to comment Share on other sites More sharing options...
pmadhwal7 Posted September 7, 2019 Author Share Posted September 7, 2019 15 hours ago, Emmanuel Delay said: Okay, I have mbl for the blue lines, msbl for the red lines. The olny thing: it doesn't extend the left break line to the same height as the right break line necessarily, I hope that's okay (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored ;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order/page3 (defun 3d-coord->pt-lstrjp (lst / r) (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst))) (reverse r) ) ;;; 2d-coord->pt-lst ;; Converts a 2d coordinates flat list into a 2d point list ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0)) (defun 2d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; test of findVertexByPoint (defun c:bb ( / pline p1 ) (setq pline (car (entsel "\nSelect subentity of polyline: "))) (setq p1 (getpoint "\nSelect point: ")) (princ (findVertexByPoint pline p1)) ) ;; given a polyline and a point on the polyline, this function returns which vertex the point is on (defun findVertexByPoint (pline p1 / lst pts i d1 d2 res) (setq res nil) (setq d1 (vlax-curve-getDistAtPoint pline p1)) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (if (= "AcDb2dPolyline" (vla-get-ObjectName (vlax-ename->vla-object pline))) ;; polyline or 2D polyline ? (setq pts (3d-coord->pt-lstrjp lst)) (setq pts (2d-coord->pt-lst lst)) ) (setq i 1) (setq d2 0.0) (repeat (- (length pts) 1) (setq d2 (vlax-curve-getDistAtPoint pline (nth i pts) )) (if (and (= res nil) (< d1 d2)) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; http://www.lee-mac.com/round.html ;; Round Up - Lee Mac ;; Rounds 'n' up to the nearest 'm' (defun LM:roundup ( n m ) ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) ;; degree to rad (defun dtr (d / ) (/ (* pi d) 180.0) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;; break line - returns the 6 points ;; gap: the gap between the aligned lines, interrupted by the diagonal lines ;; ang: angle ;; ps - pe: start point - end point ;; ext: distance to extend the aligned lines, from ps or pe ;; roundup: if set -> make sure the line is extended (not counting th extensions) to a multiple of the roundup value. ;; Example: if the line is 12.3 and roundup is 2.0 the line grows to 14.0 (again, not counting the extensions) ;; bottom coordinate stays the same, top coordinate extends ;; This should only happen if the line is vertical (defun bl (gap ang ps pe ext roundup / pm p1 p2 p3 p4 newlength) ;;(setq ps (list 0.0 0.0 0.0)) ;;(setq pe (list 5.0 0.0 0.0)) (if roundup (progn ;; check which is up (setq newlength (LM:roundup (distance ps pe) roundup)) ;; check which is up (if (< (nth 1 ps) (nth 1 pe)) ;; ps is bottom (setq pe (list (nth 0 pe) (+ (nth 1 ps) newlength))) ;; pe is bottom (setq ps (list (nth 0 ps) (+ (nth 1 pe) newlength))) ) )) (setq pm (mid ps pe)) (setq lg (* gap (/ 0.25 (sin (dtr 20))) )) ;; length of the small diagonal piece of line (setq p1 (polar pm ang (/ gap -2.0) )) ;; half the gap to the left from the midpoint (setq p2 (polar p1 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (setq p3 (polar p2 (+ ang (dtr 70.0)) (* 2.0 lg))) ;; 70° up-right (length = 2 x lg) (setq p4 (polar p3 (- ang (dtr 70.0)) lg)) ;; 70° down-right (length = lg) (list (polar ps ang (* -1. ext)) p1 p2 p3 p4 (polar pe ang ext)) ) (defun c:testbl ( / ps pe pl) (setq ps (getpoint "\nPoint 1: ")) (setq pe (getpoint "\nPoint 2: ")) (setq pl (drawLWPoly (bl 1.0 (angle ps pe) ps pe 0.18 nil) 0 ) ) ) ;;;;;;;;;;;;;;;;;;;;;;; ;; MBL for Make Break Lines ;; assuming the polylines don't have reversed order of vertices, we look for the closest start points (vertex 1) of 2 polylines. This means we have a match. (defun mbl (ext gap roundup / ss i pline1 pline2 ind dist ps1 ps2 pe1 pe2 mps mpe pl ptemp) (setq i 0) (princ "\nSelect the blue polylines: ") (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) (while (> (sslength ss) 1) (setq pline1 (vlax-ename->vla-object (ssname ss 0))) ;; why not start with the first (setq ps1 (vlax-curve-getstartpoint pline1)) (setq pe1 (vlax-curve-getendpoint pline1)) (setq i 1) ;; skip 0, we don't need to compare the same polyline (setq ind nil) (setq dist 0) (repeat (- (sslength ss) 1) (setq pline2 (vlax-ename->vla-object (ssname ss i))) (setq ps2 (vlax-curve-getstartpoint pline2)) (setq pe2 (vlax-curve-getendpoint pline2)) ;; in case endpoint and startpoint are reversed (top pline is drawn from left to right, bottom line is drawn from right to left), we may have to swap ps2/pe2 (if (< (distance ps1 pe2 ) (distance ps1 ps2 ) ) (progn ;; swap. (setq ptemp pe2) (setq pe2 ps2) (setq ps2 ptemp) )) (if (or (= ind nil) (< (distance ps1 ps2 ) dist) ) (progn (setq dist (distance ps1 ps2 )) (setq ind i) ;; remember the matching start and end points (setq mps ps2) (setq mpe pe2) )) (setq i (+ i 1)) ) ;; we should have pairs now. draw the break lines (setq pl (drawLWPoly (bl gap (angle ps1 mps) ps1 mps ext roundup) 0 ) ) (setq pl (drawLWPoly (bl gap (angle pe1 mpe) pe1 mpe ext roundup) 0 ) ) ;; now remove the two from the ss selection (ssdel (ssname ss ind) ss) (ssdel (ssname ss 0) ss) ) ) (defun c:mbl ( / ext gap ) ;; settings, feel free to change these numbers (setq ext 0.18) (setq gap 1.0) ;; invoke the main function (mbl ext gap nil) (princ) ) ;; make Scale Break Lines (defun c:msbl ( / ext gap roundup) ;; settings, feel free to change these numbers (setq ext 0.5) (setq gap 1.0) (setq roundup 2.0) ;; invoke the main function (mbl ext gap roundup) (princ) ) works fine but as you said it doesn't extend the left break line .... its ok for me i will manually extend them thanks a lot for all sir can you also help me on my other topic...if you don't mind... Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.