[编程交流] Array Block - Aligned Distance

([color=BLUE]defun[/color] c:mymeasure-bl ( [color=BLUE]/[/color] [color=BLUE]*error*[/color] bd bn ci cm di en il im in io ob p1 p2 sp )   ;(setq bn "x") ;; Name of block to insert   ([color=BLUE]setq[/color] bn ([color=BLUE]getstring[/color] [color=BLUE]t[/color] [color=BROWN]"\nEnter block Name: "[/color]))      ([color=BLUE]defun[/color] [color=BLUE]*error*[/color] ( msg )       ([color=BLUE]vla-endundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'vla-object ([color=BLUE]type[/color] ci)) ([color=BLUE]not[/color] ([color=BLUE]vlax-erased-p[/color] ci)))           ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-delete[/color] ([color=BLUE]list[/color] ci))       )       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] cm))           ([color=BLUE]setvar[/color] 'cmdecho cm)       )       ([color=BLUE]if[/color] msg           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nError: "[/color] msg))       )       ([color=BLUE]princ[/color])   )   ([color=BLUE]vla-startundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))   ([color=BLUE]cond[/color]       (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=BROWN]"layer"[/color] ([color=BLUE]getvar[/color] 'clayer))))))           ([color=BLUE]princ[/color] [color=BROWN]"\nCurrent layer locked."[/color])       )       (   ([color=BLUE]not[/color]               ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] bn [color=BROWN]".dwg"[/color])))                       ([color=BLUE]progn[/color]                           ([color=BLUE]setq[/color] cm ([color=BLUE]getvar[/color] 'cmdecho))                           ([color=BLUE]setvar[/color] 'cmdecho 0)                           ([color=BLUE]command[/color] [color=BROWN]"_.-insert"[/color] bd [color=BLUE]nil[/color])                           ([color=BLUE]setvar[/color] 'cmdecho cm)                           ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                       )                   )               )           )           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nBlock ""[/color] bn [color=BROWN]"" not found."[/color]))       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]while[/color]                   ([color=BLUE]progn[/color]                       ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=BROWN]"\nSelect object to measure: "[/color])))                       ([color=BLUE]cond[/color]                           (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))                               ([color=BLUE]princ[/color] [color=BROWN]"\nMissed, try again."[/color])                           )                           (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))                               ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] en)))                                   ([color=BLUE]princ[/color] [color=BROWN]"\nInvalid object selected."[/color])                               )                           )                       )                   )               )               ([color=BLUE]/=[/color] 'ename ([color=BLUE]type[/color] en))           )       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]initget[/color] 7)               ([color=BLUE]setq[/color] di ([color=BLUE]getdist[/color] [color=BROWN]"\nSpecify length of segment: "[/color]))           )           ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getstartpoint[/color] en)                 p2 ([color=BLUE]vlax-curve-getendpoint[/color]   en)                 ob ([color=BLUE]vlax-ename->vla-object[/color] en)                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))                            'paperspace                            'modelspace                        )                    )                 ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle p1 ([color=BLUE]/[/color] di 2.0))           )           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] il ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)))               ([color=BLUE]vlax-invoke[/color] sp 'insertblock il bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] ob ([color=BLUE]vlax-curve-getparamatpoint[/color] ob il))))           )           ([color=BLUE]vla-delete[/color] ci)           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle il di))           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] im ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)))               ([color=BLUE]vlax-invoke[/color] sp 'insertblock im bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] ob ([color=BLUE]vlax-curve-getparamatpoint[/color] ob im))))           )           ([color=BLUE]vla-delete[/color] ci)           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle im di))           ([color=BLUE]setq[/color] io [color=BLUE]T[/color])           ([color=BLUE]while[/color] io               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] in ([color=BLUE]list[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] ([color=BLUE]length[/color] ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]))) 3) ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color])))))                   ([color=BLUE]progn[/color]                       ([color=BLUE]setq[/color] io ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]equal[/color] x il 1e-6)) in)))                       ([color=BLUE]if[/color] io                           ([color=BLUE]vlax-invoke[/color] sp 'insertblock io bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] ob ([color=BLUE]vlax-curve-getparamatpoint[/color] ob io))))                       )                   )               )               ([color=BLUE]vla-delete[/color] ci)               ([color=BLUE]if[/color] io ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle io di)))               ([color=BLUE]setq[/color] il im im io)           )       )   )   ([color=BLUE]*error*[/color] [color=BLUE]nil[/color])   ([color=BLUE]princ[/color]))([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

([color=BLUE]defun[/color] c:mymeasure-bl ( [color=BLUE]/[/color] [color=BLUE]*error*[/color] bd bn ci cm di en il im in io ob p1 p2 sp )   ;(setq bn "x") ;; Name of block to insert   ([color=BLUE]setq[/color] bn ([color=BLUE]getstring[/color] [color=BLUE]t[/color] [color=BROWN]"\nEnter block Name: "[/color]))      ([color=BLUE]defun[/color] [color=BLUE]*error*[/color] ( msg )       ([color=BLUE]vla-endundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'vla-object ([color=BLUE]type[/color] ci)) ([color=BLUE]not[/color] ([color=BLUE]vlax-erased-p[/color] ci)))           ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-delete[/color] ([color=BLUE]list[/color] ci))       )       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] cm))           ([color=BLUE]setvar[/color] 'cmdecho cm)       )       ([color=BLUE]if[/color] msg           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nError: "[/color] msg))       )       ([color=BLUE]princ[/color])   )   ([color=BLUE]vla-startundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))   ([color=BLUE]cond[/color]       (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=BROWN]"layer"[/color] ([color=BLUE]getvar[/color] 'clayer))))))           ([color=BLUE]princ[/color] [color=BROWN]"\nCurrent layer locked."[/color])       )       (   ([color=BLUE]not[/color]               ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] bn [color=BROWN]".dwg"[/color])))                       ([color=BLUE]progn[/color]                           ([color=BLUE]setq[/color] cm ([color=BLUE]getvar[/color] 'cmdecho))                           ([color=BLUE]setvar[/color] 'cmdecho 0)                           ([color=BLUE]command[/color] [color=BROWN]"_.-insert"[/color] bd [color=BLUE]nil[/color])                           ([color=BLUE]setvar[/color] 'cmdecho cm)                           ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                       )                   )               )           )           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nBlock ""[/color] bn [color=BROWN]"" not found."[/color]))       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]while[/color]                   ([color=BLUE]progn[/color]                       ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=BROWN]"\nSelect object to measure: "[/color])))                       ([color=BLUE]cond[/color]                           (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))                               ([color=BLUE]princ[/color] [color=BROWN]"\nMissed, try again."[/color])                           )                           (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))                               ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] en)))                                   ([color=BLUE]princ[/color] [color=BROWN]"\nInvalid object selected."[/color])                               )                           )                       )                   )               )               ([color=BLUE]/=[/color] 'ename ([color=BLUE]type[/color] en))           )       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]initget[/color] 7)               ([color=BLUE]setq[/color] di ([color=BLUE]getdist[/color] [color=BROWN]"\nSpecify length of segment: "[/color]))           )           ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getstartpoint[/color] en)                 p2 ([color=BLUE]vlax-curve-getendpoint[/color]   en)                 ob ([color=BLUE]vlax-ename->vla-object[/color] en)                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))                            'paperspace                            'modelspace                        )                    )           )           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] il p1)               ([color=BLUE]vlax-invoke[/color] sp 'insertblock il bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] ob ([color=BLUE]vlax-curve-getparamatpoint[/color] ob il))))           )           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle il di))           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] im ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)))               ([color=BLUE]vlax-invoke[/color] sp 'insertblock im bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] ob ([color=BLUE]vlax-curve-getparamatpoint[/color] ob im))))           )           ([color=BLUE]vla-delete[/color] ci)           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle im di))           ([color=BLUE]setq[/color] io [color=BLUE]T[/color])           ([color=BLUE]while[/color] io               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] in ([color=BLUE]list[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] ([color=BLUE]length[/color] ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]))) 3) ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color])))))                   ([color=BLUE]progn[/color]                       ([color=BLUE]setq[/color] io ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]equal[/color] x il 1e-6)) in)))                       ([color=BLUE]if[/color] io                           ([color=BLUE]vlax-invoke[/color] sp 'insertblock io bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] ob ([color=BLUE]vlax-curve-getparamatpoint[/color] ob io))))                       )                   )               )               ([color=BLUE]vla-delete[/color] ci)               ([color=BLUE]if[/color] io ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle io di)))               ([color=BLUE]setq[/color] il im im io)           )       )   )   ([color=BLUE]*error*[/color] [color=BLUE]nil[/color])   ([color=BLUE]princ[/color]))([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

([color=BLUE]defun[/color] c:mymeasure-bl ( [color=BLUE]/[/color] [color=BLUE]*error*[/color] bd bn ci cm di el en il im in io ob p1 p2 sp )   ;(setq bn "x") ;; Name of block to insert   ([color=BLUE]setq[/color] bn ([color=BLUE]getstring[/color] [color=BLUE]t[/color] [color=BROWN]"\nEnter block Name: "[/color]))      ([color=BLUE]defun[/color] [color=BLUE]*error*[/color] ( msg )       ([color=BLUE]vla-endundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'vla-object ([color=BLUE]type[/color] ci)) ([color=BLUE]not[/color] ([color=BLUE]vlax-erased-p[/color] ci)))           ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-delete[/color] ([color=BLUE]list[/color] ci))       )       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] cm))           ([color=BLUE]setvar[/color] 'cmdecho cm)       )       ([color=BLUE]if[/color] msg           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nError: "[/color] msg))       )       ([color=BLUE]princ[/color])   )   ([color=BLUE]vla-startundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))   ([color=BLUE]cond[/color]       (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=BROWN]"layer"[/color] ([color=BLUE]getvar[/color] 'clayer))))))           ([color=BLUE]princ[/color] [color=BROWN]"\nCurrent layer locked."[/color])       )       (   ([color=BLUE]not[/color]               ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] bn [color=BROWN]".dwg"[/color])))                       ([color=BLUE]progn[/color]                           ([color=BLUE]setq[/color] cm ([color=BLUE]getvar[/color] 'cmdecho))                           ([color=BLUE]setvar[/color] 'cmdecho 0)                           ([color=BLUE]command[/color] [color=BROWN]"_.-insert"[/color] bd [color=BLUE]nil[/color])                           ([color=BLUE]setvar[/color] 'cmdecho cm)                           ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                       )                   )               )           )           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nBlock ""[/color] bn [color=BROWN]"" not found."[/color]))       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]while[/color]                   ([color=BLUE]progn[/color]                       ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=BROWN]"\nSelect object to measure: "[/color])))                       ([color=BLUE]cond[/color]                           (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))                               ([color=BLUE]princ[/color] [color=BROWN]"\nMissed, try again."[/color])                           )                           (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))                               ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] en)))                                   ([color=BLUE]princ[/color] [color=BROWN]"\nInvalid object selected."[/color])                               )                           )                       )                   )               )               ([color=BLUE]/=[/color] 'ename ([color=BLUE]type[/color] en))           )       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]initget[/color] 7)               ([color=BLUE]setq[/color] di ([color=BLUE]getdist[/color] [color=BROWN]"\nSpecify length of segment: "[/color]))           )           ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getstartpoint[/color] en)                 p2 ([color=BLUE]vlax-curve-getendpoint[/color]   en)                 ob ([color=BLUE]vlax-ename->vla-object[/color] en)                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))                            'paperspace                            'modelspace                        )                    )                 ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle p1 ([color=BLUE]/[/color] di 2.0))           )           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] il ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)))               ([color=BLUE]vlax-invoke[/color] sp 'insertblock il bn 1.0 1.0 1.0 0.0)           )           ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color]))           ([color=BLUE]vla-delete[/color] ci)           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle il di))           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] im ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)))               ([color=BLUE]vlax-invoke[/color] sp 'insertblock im bn 1.0 1.0 1.0 0.0)           )           ([color=BLUE]vla-put-rotation[/color] ([color=BLUE]vlax-ename->vla-object[/color] el) ([color=BLUE]angle[/color] il im))           ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color]))           ([color=BLUE]vla-delete[/color] ci)           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle im di))           ([color=BLUE]setq[/color] io [color=BLUE]T[/color])           ([color=BLUE]while[/color] io               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] in ([color=BLUE]list[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] ([color=BLUE]length[/color] ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]))) 3) ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color])))))                   ([color=BLUE]progn[/color]                       ([color=BLUE]setq[/color] io ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]equal[/color] x il 1e-6)) in)))                       ([color=BLUE]if[/color] io                           ([color=BLUE]progn[/color]                               ([color=BLUE]vla-put-rotation[/color] ([color=BLUE]vlax-ename->vla-object[/color] el) ([color=BLUE]angle[/color] im io))                               ([color=BLUE]vlax-invoke[/color] sp 'insertblock io bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] im io))                               ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color]))                           )                       )                   )               )               ([color=BLUE]vla-delete[/color] ci)               ([color=BLUE]if[/color] io ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle io di)))               ([color=BLUE]setq[/color] il im im io)           )       )   )   ([color=BLUE]*error*[/color] [color=BLUE]nil[/color])   ([color=BLUE]princ[/color]))([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

([color=BLUE]defun[/color] c:mymeasure-bl ( [color=BLUE]/[/color] [color=BLUE]*error*[/color] bd bn ci cm di el en il im in io ob p1 p2 sp )   ;(setq bn "x") ;; Name of block to insert   ([color=BLUE]setq[/color] bn ([color=BLUE]getstring[/color] [color=BLUE]t[/color] [color=BROWN]"\nEnter block Name: "[/color]))      ([color=BLUE]defun[/color] [color=BLUE]*error*[/color] ( msg )       ([color=BLUE]vla-endundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'vla-object ([color=BLUE]type[/color] ci)) ([color=BLUE]not[/color] ([color=BLUE]vlax-erased-p[/color] ci)))           ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-delete[/color] ([color=BLUE]list[/color] ci))       )       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] cm))           ([color=BLUE]setvar[/color] 'cmdecho cm)       )       ([color=BLUE]if[/color] msg           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nError: "[/color] msg))       )       ([color=BLUE]princ[/color])   )   ([color=BLUE]vla-startundomark[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))   ([color=BLUE]cond[/color]       (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=BROWN]"layer"[/color] ([color=BLUE]getvar[/color] 'clayer))))))           ([color=BLUE]princ[/color] [color=BROWN]"\nCurrent layer locked."[/color])       )       (   ([color=BLUE]not[/color]               ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] bn [color=BROWN]".dwg"[/color])))                       ([color=BLUE]progn[/color]                           ([color=BLUE]setq[/color] cm ([color=BLUE]getvar[/color] 'cmdecho))                           ([color=BLUE]setvar[/color] 'cmdecho 0)                           ([color=BLUE]command[/color] [color=BROWN]"_.-insert"[/color] bd [color=BLUE]nil[/color])                           ([color=BLUE]setvar[/color] 'cmdecho cm)                           ([color=BLUE]tblsearch[/color] [color=BROWN]"block"[/color] bn)                       )                   )               )           )           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=BROWN]"\nBlock ""[/color] bn [color=BROWN]"" not found."[/color]))       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]while[/color]                   ([color=BLUE]progn[/color]                       ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=BROWN]"\nSelect object to measure: "[/color])))                       ([color=BLUE]cond[/color]                           (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))                               ([color=BLUE]princ[/color] [color=BROWN]"\nMissed, try again."[/color])                           )                           (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))                               ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] en)))                                   ([color=BLUE]princ[/color] [color=BROWN]"\nInvalid object selected."[/color])                               )                           )                       )                   )               )               ([color=BLUE]/=[/color] 'ename ([color=BLUE]type[/color] en))           )       )       (   ([color=BLUE]progn[/color]               ([color=BLUE]initget[/color] 7)               ([color=BLUE]setq[/color] di ([color=BLUE]getdist[/color] [color=BROWN]"\nSpecify length of segment: "[/color]))           )           ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getstartpoint[/color] en)                 p2 ([color=BLUE]vlax-curve-getendpoint[/color]   en)                 ob ([color=BLUE]vlax-ename->vla-object[/color] en)                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))                            'paperspace                            'modelspace                        )                    )           )           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] il p1)               ([color=BLUE]vlax-invoke[/color] sp 'insertblock il bn 1.0 1.0 1.0 0.0)           )           ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color]))           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle il di))           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] im ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)))               ([color=BLUE]vlax-invoke[/color] sp 'insertblock im bn 1.0 1.0 1.0 0.0)           )           ([color=BLUE]vla-put-rotation[/color] ([color=BLUE]vlax-ename->vla-object[/color] el) ([color=BLUE]angle[/color] il im))            ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color]))           ([color=BLUE]vla-delete[/color] ci)           ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle im di))           ([color=BLUE]setq[/color] io [color=BLUE]T[/color])           ([color=BLUE]while[/color] io               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] in ([color=BLUE]list[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]) '(0.0 0.0 0.0)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] ([color=BLUE]length[/color] ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color]))) 3) ([color=BLUE]cdddr[/color] ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ci [color=BLUE]acextendnone[/color])))))                   ([color=BLUE]progn[/color]                       ([color=BLUE]setq[/color] io ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]equal[/color] x il 1e-6)) in)))                       ([color=BLUE]if[/color] io                           ([color=BLUE]progn[/color]                               ([color=BLUE]vla-put-rotation[/color] ([color=BLUE]vlax-ename->vla-object[/color] el) ([color=BLUE]angle[/color] im io))                               ([color=BLUE]vlax-invoke[/color] sp 'insertblock io bn 1.0 1.0 1.0 ([color=BLUE]angle[/color] im io))                               ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color]))                           )                       )                   )               )               ([color=BLUE]vla-delete[/color] ci)               ([color=BLUE]if[/color] io ([color=BLUE]setq[/color] ci ([color=BLUE]vlax-invoke[/color] sp 'addcircle io di)))               ([color=BLUE]setq[/color] il im im io)           )       )   )   ([color=BLUE]*error*[/color] [color=BLUE]nil[/color])   ([color=BLUE]princ[/color]))([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])