error:extra cdrs in dotted pair on input

error:extra cdrs in dotted pair on input

tawan_survey
Participant Participant
748 Views
3 Replies
Message 1 of 4

error:extra cdrs in dotted pair on input

tawan_survey
Participant
Participant

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])

 



0 Likes
Accepted solutions (1)
749 Views
3 Replies
Replies (3)
Message 2 of 4

CADaSchtroumpf
Advisor
Advisor
Accepted solution

And if you remove the color coded of tags, have you always the error?

(defun c:test ( / a1 d1 d2 d3 e1 e2 p1 p2 sp xl zv )
   (if
       (and
           (setq e1 (LM:ssget "\nSelect 1st Polyline: " '("_+.:E:S" ((0 . "LWPOLYLINE")))))
           (setq e2 (LM:ssget "\nSelect 2nd Polyline: " '("_+.:E:S" ((0 . "LWPOLYLINE")))))
           (progn
               (initget 6)
               (setq d1 (getdist  "\nSpecify Step Distance: "))
           )
       )
       (progn
           (setq d3 (- d1)
                 e1 (ssname e1 0)
                 e2 (vlax-ename->vla-object (ssname e2 0))
                 d2 (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1))
                 zv (trans '(0.0 0.0 1.0) 1 0 t)
                 sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                        (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
                    )
           )
           (while (<= (setq d3 (+ d3 d1)) d2)
               (setq p1 (vlax-curve-getpointatdist e1 d3)
                     a1 (- (angle '(0.0 0.0) (trans (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p1)) 0 1)) (/ pi 2.0))
                     xl (vlax-invoke sp 'addxline p1 (trans (polar (trans p1 0 1) a1 1.0) 1 0))
               )
               (if
                   (setq p2
                       (car
                           (vl-sort (LM:group3 (vlax-invoke xl 'intersectwith e2 acextendthisentity))
                              '(lambda ( a b ) (< (distance a p1) (distance b p1)))
                           )
                       )
                   )
                   (progn
                       (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
                       (entmake
                           (list
                              '(0 . "TEXT")
                               (cons 10 (trans p1 0 zv))
                               (cons 11 (trans p1 0 zv))
                               (cons 50 (+ a1 (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 zv t))))
                               (cons 40 (getvar 'textsize))
                               (cons 07 (getvar 'textstyle))
                               (cons 01 (strcat "L=" (rtos (distance p1 p2) 2) "m"))
                              '(72 . 0)
                              '(73 . 2)
                               (cons 210 zv)
                           )
                       )
                   )                                
               )
               (vla-delete xl)
           )
       )
   )
   (princ)
)

(defun LM:group3 ( lst / rtn )
   (repeat (/ (length lst) 3)
       (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
             lst (cdddr lst)
       )
   )
   (reverse rtn)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt

(defun LM:ssget ( msg params / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget params))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)
0 Likes
Message 3 of 4

john.uhden
Mentor
Mentor

@CADaSchtroumpf 

Thanks for figuring that out (and weeding out all the excess).

I had no idea what all the brackets were about.  I almost thought that Lee Mac had invented some new kind of code.

John F. Uhden

0 Likes
Message 4 of 4

Sea-Haven
Mentor
Mentor

 

([color=BLUE]princ[/color] msg)

 

 

(princ msg)

 

Hi John thought you would no about BBC coding, when forums update to new products the text display coding becomes exposed sometimes

0 Likes