Message 1 of 4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I am trying to use LISP by Lee Mac but I get message "error:extra cdrs in dotted pair on input" in Visual LISP
plz help me to edit this Lisp
from https://www.cadtutor.net/forum/topic/44246-measure-distance-between-polylines/page/2/
ps. My english skill is bad
([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] a1 d1 d2 d3 e1 e2 p1 p2 sp xl zv )
([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] e1 (LM:ssget [color=MAROON]"\nSelect 1st Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
([color=BLUE]setq[/color] e2 (LM:ssget [color=MAROON]"\nSelect 2nd Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
([color=BLUE]progn[/color]
([color=BLUE]initget[/color] 6)
([color=BLUE]setq[/color] d1 ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify Step Distance: "[/color]))
)
)
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] d3 ([color=BLUE]-[/color] d1)
e1 ([color=BLUE]ssname[/color] e1 0)
e2 ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] e2 0))
d2 ([color=BLUE]vlax-curve-getdistatparam[/color] e1 ([color=BLUE]vlax-curve-getendparam[/color] e1))
zv ([color=BLUE]trans[/color] '(0.0 0.0 1.0) 1 0 [color=BLUE]t[/color])
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]while[/color] ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] d3 ([color=BLUE]+[/color] d3 d1)) d2)
([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getpointatdist[/color] e1 d3)
a1 ([color=BLUE]-[/color] ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getfirstderiv[/color] e1 ([color=BLUE]vlax-curve-getparamatpoint[/color] e1 p1)) 0 1)) ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
xl ([color=BLUE]vlax-invoke[/color] sp 'addxline p1 ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]trans[/color] p1 0 1) a1 1.0) 1 0))
)
([color=BLUE]if[/color]
([color=BLUE]setq[/color] p2
([color=BLUE]car[/color]
([color=BLUE]vl-sort[/color] (LM:group3 ([color=BLUE]vlax-invoke[/color] xl 'intersectwith e2 [color=BLUE]acextendthisentity[/color]))
'([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]<[/color] ([color=BLUE]distance[/color] a p1) ([color=BLUE]distance[/color] b p1)))
)
)
)
([color=BLUE]progn[/color]
([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 p1) ([color=BLUE]cons[/color] 11 p2)))
([color=BLUE]entmake[/color]
([color=BLUE]list[/color]
'(0 . [color=MAROON]"TEXT"[/color])
([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] p1 0 zv))
([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] p1 0 zv))
([color=BLUE]cons[/color] 50 ([color=BLUE]+[/color] a1 ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'ucsxdir) 0 zv [color=BLUE]t[/color]))))
([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'textsize))
([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
([color=BLUE]cons[/color] 01 ([color=BLUE]strcat[/color] [color=MAROON]"L="[/color] ([color=BLUE]rtos[/color] ([color=BLUE]distance[/color] p1 p2) 2) [color=MAROON]"m"[/color]))
'(72 . 0)
'(73 . 2)
([color=BLUE]cons[/color] 210 zv)
)
)
)
)
([color=BLUE]vla-delete[/color] xl)
)
)
)
([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] LM:group3 ( lst [color=BLUE]/[/color] rtn )
([color=BLUE]repeat[/color] ([color=BLUE]/[/color] ([color=BLUE]length[/color] lst) 3)
([color=BLUE]setq[/color] rtn ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cadr[/color] lst) ([color=BLUE]caddr[/color] lst)) rtn)
lst ([color=BLUE]cdddr[/color] lst)
)
)
([color=BLUE]reverse[/color] rtn)
)
[color=GREEN];; ssget - Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
([color=BLUE]princ[/color] msg)
([color=BLUE]setvar[/color] 'nomutt 1)
([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
([color=BLUE]setvar[/color] 'nomutt 0)
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel)) sel)
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])
Solved! Go to Solution.