Jump to content

Midpoint of the line not found.


Grrr

Recommended Posts

Hi guys,

Today I tried some of the Lee Mac's style of coding - by combining the cond and not functions. I think I understand the reason why he does that - its easy to toggle and find the breakpoint in the code. So in my case is this one:

Midpoint of the line not found.

The problem is that I don't understand whats wrong with it, so I ran VLIDE and watched some of the variables:

LOG Watch
...............
MIDPT = (2377.57 -1262.93 0.0)
ENDPT2 = (3345.54 -1666.0 0.0)
ENDPT1 = (1409.6 -859.868 0.0)
LINE = ((1409.6 -859.868 0.0) (3345.54 -1666.0 0.0))
ENTITYTYPE = "LWPOLYLINE"
ENT = (<Entity name: 7ff6d2304ea0> (1812.88 -1048.75 0.0))
CENSSBOX = (2556.4 1934.71 0.0)
SSBOX = ((1891.74 1157.88 0.0) (3221.06 2711.53 0.0))
...............

Basically I'm trying to move a SS from that "CENSSBOX" to the "MIDPT" point variable. I know that I have 2 different methods of finding those points.

Actually I individually tested the variables - with POINT command I managed to draw their correct positions - but combined together for the move command? - the code tells me to get lost.

Here it is BTW:

; Moves selection from its center to the midpoint of the picked LINE or PLINE's segment

(defun c:test ( / pdm ss ssbox censsbox ent entitytype line endpt1 endpt2 midpt )
(vl-load-com)
(setq pdm (getvar 'PDMODE))
(setvar 'PDMODE 35)
(while
	(cond 
		( (not (and (princ "\nSelect objects to move") (setq ss (ssget "_:L")))) 
			(princ "\nNothing selected.")
		)
		( (not (setq ssbox (LM:ssboundingbox ss)))
			(princ "\nUnable to calculate bounding box for selection.")
		)
		( (not (setq censsbox (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) ssbox)) )) 
			(princ "\nUnable to find bounding box's centroid.")
		)
		( (not (setq ent (entsel "\nPick a line or a polyline's segment"))) 
			(princ "\nMissed.. Try again!")
		)
		( (not (setq entitytype (cdr (assoc 0 (entget (car ent))))) ) 
			(princ "\nEntitytype not found.")
		)
		( 
			(progn
				(setq line (get_ends ent))
				(setq endpt1 (car  line))
				(setq endpt2 (cadr  line))
				(setq midpt (mid endpt1 endpt2))
			)
			(princ "\nMidpoint of the line not found.")
		)
		(
			(progn
				(vl-cmdf "_.move" ss ""
					"_non" censsbox
					"_non" midpt
				)
				(princ (strcat "\nThis time you picked \"" entitytype "\" entity! " ))
			)
		)
	);cond
	(setvar 'PDMODE pdm)
);while
(princ)
)

; (command "_.POINT" endpt1 )
; (command "_.POINT" endpt2 )
; (command "_.POINT" censsbox )
; (command "_.POINT" midpt )


(defun mid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)

; Stefan BMR
(defun get_ends (e / o p p1 p2 b)
(setq o  (car e)
	b  (eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
	p  (vlax-curve-getparamatpoint
		o
		(vlax-curve-getclosestpointto o (trans (cadr e) 1 0))
	)
	p1 (if b
		(fix p)
		(vlax-curve-getstartparam o)
	)
	p2 (if b
		(1+ p1)
		(vlax-curve-getendparam o)
	)
)
(if (> (- p2 p) (- p p1))
	(list
		(trans (vlax-curve-getpointatparam o p1) 0 1)
		(trans (vlax-curve-getpointatparam o p2) 0 1)
	)
	(list
		(trans (vlax-curve-getpointatparam o p2) 0 1)
		(trans (vlax-curve-getpointatparam o p1) 0 1)
	)
)
)

(defun LM:listmid ( lst )
((lambda ( n ) (mapcar '(lambda ( x ) (/ x n)) (apply 'mapcar (cons '+ lst)))) (length lst))
)

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
	(if
		(and
			(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
			(vlax-method-applicable-p o 'getboundingbox)
			(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
		)
		(setq m (cons (vlax-safearray->list a) m)
			n (cons (vlax-safearray->list b) n)
		)
	)
)
(if (and m n)
	(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)




Link to comment
Share on other sites

  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • Grrr

    9

  • David Bethel

    8

  • Lee Mac

    4

Hi Lee,

I really don't understand the problem, on the "Log Watch" I clearly see that "midpt" variable returns (2377.57 -1262.93 0.0).

I assume that its a point coordinates.

 

EDIT:

I've found the problem...

			( 
			(not
				(progn
					(setq line (get_ends ent))
					(setq endpt1 (car  line))
					(setq endpt2 (cadr  line))
					(setq midpt (mid endpt1 endpt2))
				)
			)
			(princ "\nMidpoint of the line not found.")
		)

I'll need to study alot carefully how cond works.

I got stuck on a 2nd problem on the entsel part, I'm gonna try some while loop on it.

Edited by Grrr
Link to comment
Share on other sites

If any test in the (cond) test sequence has a non nil return, (cond) stops evaluating the remaining conditional tests. ie. If midpt is set, then the move command is never implemented

 

 

-David

Link to comment
Share on other sites

Thanks David,

So.. is that how really works - the whole process:

(cond 
( (not (Stuff to do #1))) ; evaluate arguments from user and continue if TRUE next to #2
	(princ "\nStuff to do #1 are not done, do them to continiue")
)
( (not (Stuff to do #2))) ; evaluate arguments from user and continue if TRUE next to #3
	(princ "\nStuff to do #2 are not done, do them to continiue")
)
( (not (Stuff to do #3))) ; evaluate arguments from user and continue if TRUE next for the code to compute
	(princ "\nStuff to do #3 are not done, do them to continiue")
)
( (not (We got everything we need from Stuff #1, #2 and #3, now the code does its job... )) ; every argument has been evaluated, the code proceeds with the results
	(princ "\nEverything is provided for the code, but it failed!")
)
);cond

 

Heres the fixed code (it was a practice):

; Moves selection from its center to the midpoint of the picked LINE or PLINE's segment

(defun c:test ( / pdm ss ssbox censsbox ent entitytype line endpt1 endpt2 midpt )
(vl-load-com)
(setq pdm (getvar 'PDMODE))
(setvar 'PDMODE 35)
(while
	(cond 
		( (not (and (princ "\nSelect objects to move") (setq ss (ssget "_:L")))) 
			(princ "\nNothing selected.")
		)
		( (not (setq ssbox (LM:ssboundingbox ss)))
			(princ "\nUnable to calculate bounding box for selection.")
		)
		( (not (setq censsbox (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) ssbox)) )) 
			(princ "\nUnable to find bounding box's centroid.")
		)
		( (not (while (not (setq ent (entsel "\nPick a line or a polyline's segment"))) ent (princ "\nMissed.. Try again!")) ) 
		)
		( (not (setq entitytype (cdr (assoc 0 (entget (car ent))))) ) 
			(princ "\nEntitytype not found.")
		)
		( 
			(not
				(progn
					(setq line (get_ends ent))
					(setq endpt1 (car  line))
					(setq endpt2 (cadr  line))
					(setq midpt (mid endpt1 endpt2))
				)
			)
			(princ "\nMidpoint of the line not found.")
		)
		(
			(progn
				(vl-cmdf "_.move" ss ""
					"_non" censsbox
					"_non" midpt
				)
				(princ (strcat "\nThis time you picked \"" entitytype "\" entity! " ))
			)
		)
	);cond
	(setvar 'PDMODE pdm)
);while
(princ)
)

; (command "_.POINT" endpt1 )
; (command "_.POINT" endpt2 )
; (command "_.POINT" censsbox )
; (command "_.POINT" midpt )


(defun mid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)

; Stefan BMR
(defun get_ends (e / o p p1 p2 b)
(setq o  (car e)
	b  (eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
	p  (vlax-curve-getparamatpoint
		o
		(vlax-curve-getclosestpointto o (trans (cadr e) 1 0))
	)
	p1 (if b
		(fix p)
		(vlax-curve-getstartparam o)
	)
	p2 (if b
		(1+ p1)
		(vlax-curve-getendparam o)
	)
)
(if (> (- p2 p) (- p p1))
	(list
		(trans (vlax-curve-getpointatparam o p1) 0 1)
		(trans (vlax-curve-getpointatparam o p2) 0 1)
	)
	(list
		(trans (vlax-curve-getpointatparam o p2) 0 1)
		(trans (vlax-curve-getpointatparam o p1) 0 1)
	)
)
)

(defun LM:listmid ( lst )
((lambda ( n ) (mapcar '(lambda ( x ) (/ x n)) (apply 'mapcar (cons '+ lst)))) (length lst))
)

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
	(if
		(and
			(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
			(vlax-method-applicable-p o 'getboundingbox)
			(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
		)
		(setq m (cons (vlax-safearray->list a) m)
			n (cons (vlax-safearray->list b) n)
		)
	)
)
(if (and m n)
	(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)




EDIT:

Did some experimenting to fix some small issues and again, I changed this part:

			( (while (not (setq ent (entsel "\nPick a line or a polyline's segment"))) ent )
		)

Its very handy to experiment like that with every statement of the cond, without getting the code to fail immediately! :D

Edited by Grrr
Link to comment
Share on other sites

I prefer (and) testing

(and (do step 1)
    (do step 2)
    (do step 3)
)

 

This will stop if any step fails to return a non nil value. I'm not a fan of creating a pick set inclusive in other tests

 

(while (not ss)
         (setq ss (ssget)))

 

If you didn't select anything, why run the program? Otherwise you have to start the routine again. My $0.02

 

-David

Link to comment
Share on other sites

I agree about that, David

 

I just wanted to try and see what would be the difference with that type of writing the code...

So you were talking for something like this:

(if
(and ; Evaluate arguments from user within the "and" function
	(if
		(not (Stuff to do #1 ))
		(princ "\nTheres something wrong in #1 try again!")
		(Stuff to do #1 )
	)
	(if
		(not (Stuff to do #2 ))
		(princ "\nTheres something wrong in #2 try again!")
		(Stuff to do #2 )
	)
	(if
		(not (Stuff to do #3 ))
		(princ "\nTheres something wrong in #3 try again!")
		(Stuff to do #3 )
	)
); All arguments are evaluated, the code proceeds
(while somethingisdone ; example: a selection was made and the same must be copied or moved within the while loop
	(progn
		(while 
			(not (setq pickline (entsel "\nPick a line")))
			pickline
			(cond
				(   (= 7 (getvar 'errno))
					(princ "\nYou must select a line.")
				)
				(   (null pickline)
					(princ "\nYou missed, try again.")
				)
			)
		); to exit this loop and continue a line must be picked
		(We got everything we need from Stuff #1, #2 and #3, now the code does its job... )
	); the code did its job, exiting with my favourite ESC key, and don't forget the error handling if needed!
)
);if					

I did a little complicated example, and I'm not sure will those "breakpoints" within the and function would work.

 

Anyway, I'm trying to learn from the best ones in the forum - and everytime I feel that I'm doing like 80% of my code and for the rest 20% I must get help from you guys, since it seems impossible for me to find the mistake, no matter how hard I try.

Link to comment
Share on other sites

It's more of a personal preference.

 

Mine happens to be:

 

  • (initget)->(get) all user inputs
  • (ssget) with filters
  • do the whatever it is you are doing

 

As to error checking and reporting back, the vast majority of errors that happen

during development either crash the entire routine or does something so very

obvious it would be impossible to miss.

 

Another priority for me is readablility. I have routine that are decades old. If I have to

edit them some day, it's to be in a format that I can read and decipher quickly.

 

The (and) test lets you do serveral tests simultaniously.

 

ie as an example :

 

To edit the nnn_th number ATTRIBute that is color c only

 

[b][color=BLACK]([/color][/b]defun c:ean [b][color=FUCHSIA]([/color][/b]/ n et ns ss i en an ad x et nv c[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]initget 7[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq n [b][color=NAVY]([/color][/b]getint [color=#2f4f4f]"\nATTRIBute Number To Edit:  "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not c[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]> c 255[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]initget 4[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq c [b][color=MAROON]([/color][/b]getint [color=#2f4f4f]"\nATTRIBute Color Number:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]initget 1 [color=#2f4f4f]"Replace Prefix Suffix"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq et [b][color=NAVY]([/color][/b]getkword [color=#2f4f4f]"\nEdit Type - Replace Prefix Suffix:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]cond [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= et [color=#2f4f4f]"Replace"[/color][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]setq ns [b][color=GREEN]([/color][/b]getstring t [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"\nString To Add As ATTRIBute "[/color] [b][color=RED]([/color][/b]itoa n[b][color=RED])[/color][/b] [color=#2f4f4f]":   "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= et [color=#2f4f4f]"Prefix"[/color][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]setq ns [b][color=GREEN]([/color][/b]getstring t [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"\nPrefix To Add As ATTRIBute "[/color] [b][color=RED]([/color][/b]itoa n[b][color=RED])[/color][/b] [color=#2f4f4f]":   "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= et [color=#2f4f4f]"Suffix"[/color][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]setq ns [b][color=GREEN]([/color][/b]getstring t [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"\nPrefix To Add As ATTRIBute "[/color] [b][color=RED]([/color][/b]itoa n[b][color=RED])[/color][/b] [color=#2f4f4f]":   "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not ss[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=BLUE])[/color][/b]
                              [b][color=BLUE]([/color][/b]cons 66 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq i 0[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq an [b][color=MAROON]([/color][/b]entnext en[b][color=MAROON])[/color][/b]
              ad [b][color=MAROON]([/color][/b]entget an[b][color=MAROON])[/color][/b]
               x 1[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]= [color=#2f4f4f]"ATTRIB"[/color] [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 0 ad[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b]and [b][color=GREEN]([/color][/b]= x n[b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]= c [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 62 ad[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]setq nv [b][color=BLUE]([/color][/b]cond [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]= et [color=#2f4f4f]"Replace"[/color][b][color=PURPLE])[/color][/b] ns[b][color=RED])[/color][/b]
                                   [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]= et [color=#2f4f4f]"Prefix"[/color][b][color=PURPLE])[/color][/b]  [b][color=PURPLE]([/color][/b]strcat ns [b][color=TEAL]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc 1 ad[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                                   [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]= et [color=#2f4f4f]"Suffix"[/color][b][color=PURPLE])[/color][/b]  [b][color=PURPLE]([/color][/b]strcat [b][color=TEAL]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc 1 ad[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] ns[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]setq ad [b][color=BLUE]([/color][/b]subst [b][color=RED]([/color][/b]cons 1 nv[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]assoc 1 ad[b][color=RED])[/color][/b] ad[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]entmod ad[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]setq x [b][color=GREEN]([/color][/b]1+ x[b][color=GREEN])[/color][/b]
                     an [b][color=GREEN]([/color][/b]entnext an[b][color=GREEN])[/color][/b]
                     ad [b][color=GREEN]([/color][/b]entget an[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entupd en[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]1+ i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

There is no "Correct" way, only ways that work or don't work. And that are

configured properly to deal with the AutoCAD environment ( localize variables,

reset sysvar )

 

HTH -David

 

-David

Link to comment
Share on other sites

The (and) test lets you do serveral tests simultaniously.

Yes, I know about it. But sometimes if the error isn't so obvious - its needed to toggle these breakpoints.

Unless you are a VLIDE user, and have the advantage of its debugging functionality.

 

Another priority for me is readablility.

David,

I've always wondered how do you achieve such syntax color readability.

I've searched and I couldn't find anywhere how to increment the syntaxes, with applying color on them, just like in your example.

Link to comment
Share on other sites

I don't use vlide interface ( It didn't come around until Release 2000 )

 

In the older versions, if *error* is set nil and an error is encountered, the entire routine is called back

 

[b][color=BLACK]([/color][/b]defun c:test [b][color=FUCHSIA]([/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq *error* nil[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq a
   [b][color=NAVY]([/color][/b]setq b
     [b][color=MAROON]([/color][/b]setq c
       [b][color=GREEN]([/color][/b]setq d [b][color=BLUE]([/color][/b]/ 1.0 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=BLACK])[/color][/b]

 

Returned

 

Command: test
error: divide by zero
(/ 1.0 0)
(SETQ D (/ 1.0 0))
(SETQ C (SETQ D (/ 1.0 0)))
(SETQ B (SETQ C (SETQ D (/ 1.0 0))))
(SETQ A (SETQ B (SETQ C (SETQ D (/ 1.0 0)))))
(C:TEST)
*Cancel*

 

vs 2000 and on :

Command: test
; error: divide by zero

 

This alone is 1 of the big reasons I never embraced the newer releases.

 

As to coloring, most of the original autolisp parenthesis checkers were color matched program. They were stand alone .exe files.

 

When Autodesk ditched Compuserve for it's official forum and started it own internet based forum, it used only html format. As did some of the independent group.

 

I simply made a lisp routine that converted .lsp file into .htm file and added the color matching. With CADtutor, posting use bbc coding in the message body. So I simply changed the routine to output in bbc code format.

 

http://www.bbcode.org/reference.php

 

I use it mainly here because I feel it is a better teaching tool. I do use a program Ally 3.0 for production work for error checking and analyzing routines as they are being developed.

 

-David

Link to comment
Share on other sites

In the older versions, if *error* is set nil and an error is encountered, the entire routine is called back

[b][color=BLACK]([/color][/b]defun c:test [b][color=FUCHSIA]([/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq *error* nil[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq a
   [b][color=NAVY]([/color][/b]setq b
     [b][color=MAROON]([/color][/b]setq c
       [b][color=GREEN]([/color][/b]setq d [b][color=BLUE]([/color][/b]/ 1.0 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=BLACK])[/color][/b]

Returned

 

Command: test
error: divide by zero
(/ 1.0 0)
(SETQ D (/ 1.0 0))
(SETQ C (SETQ D (/ 1.0 0)))
(SETQ B (SETQ C (SETQ D (/ 1.0 0))))
(SETQ A (SETQ B (SETQ C (SETQ D (/ 1.0 0)))))
(C:TEST)
*Cancel*

vs 2000 and on :

Command: test
; error: divide by zero

This alone is 1 of the big reasons I never embraced the newer releases.

 

For what its worth, there is the Visual LISP (vl-bt) function, which will perform a similar backtrace:

(defun c:test ( / *error* a b c d )
   (setq *error* '(( m ) (vl-bt)))
   (setq a
       (setq b
           (setq c
               (setq d (/ 1.0 0))
           )
       )
   )
)

Command: test Backtrace:
[0.58] (VL-BT)
[1.54] (#<SUBR @000000002c5dc610 -lambda-> "divide by zero")
[2.50] (ill-fun-hk "divide by zero")
[3.45] (((M) (VL-BT)) "divide by zero")
[4.40] (_call-err-hook ((M) (VL-BT)) "divide by zero")
[5.34] (sys-error "divide by zero")
:ERROR-BREAK.29 "divide by zero"
[6.26] (/ 1.0 0)
[7.20] (C:TEST) LAP+28
[8.15] (#<SUBR @000000002c5dc5e8 -rts_top->)
[9.12] (#<SUBR @000000002c598700 veval-str-body> "(C:TEST)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)

Link to comment
Share on other sites

Lee,

 

Yes, i did try that for a while, but I found it be anywhere from a bit cryptic to very cryptic.

 

The older version's main drawback was dreaded 'error: bad argument type'

 

It would not tell you what the call was expecting ie numberp listp stringp

Only just that it wasn't correct.

 

I always felt that errno should have been expanded and/or allowed to mature into a robust listing of known screw ups.

 

-David

 

As an aside, I've tried Notepad++, but with unimpressive results. I find it to be not a true ASCII editor as it retains the tab characters on a regular basis.

Link to comment
Share on other sites

I simply made a lisp routine that converted .lsp file into .htm file and added the color matching.

Any chance of sharing it?

 

I have about 5 years of ACAD experience, 3 years using lisp and a few months of LISP code writing practice and I feel like a total newbie when I read your posts about 2000's.

I'm fairly new to programming (since I started to feel bad about asking for a complete routines everytime on the forum) so I try to reduce the amount of such posts from my side if possible.

Now I practice on my formatting and debugging skills, but ofcourse these bring up more additional questions.

 

Sorry for the offtopic posts.

Link to comment
Share on other sites

As an aside, I've tried Notepad++, but with unimpressive results. I find it to be not a true ASCII editor as it retains the tab characters on a regular basis.

 

N++ will retain tab characters which are already present, but it does also provide the option to convert these to spaces under: Edit > Blank Operations > TAB to Space.

 

You can avoid inserting tabs when writing code by going to Settings > Preferences > Tab Settings > [Default] and ensure Replace by space is ticked.

 

Any chance of sharing it?

 

I seem to recall that David posted the routine here a few years back; alternatively, here is a similar routine from several years ago.

Link to comment
Share on other sites

I seem to recall that David posted the routine here a few years back; alternatively, here is a similar routine from several years ago.

Lee,

I've seen this before!

Perhaps now its my time to try it. But I still have to ask is it possible to configure the styles list to increment the brackets? I mean something like this:

'(
  ("[code ]"            "[/ code]" )  ;; Container
  ("[color =DARKRED]"   "[/ color]")  ;; Quotes/Dots
 [color=RED] ("[color =RED]"       "[/ color]")  ;; 1st level Brackets
  ("[color =GREEN]"     "[/ color]")  ;; 2nd level Brackets
  ("[color =BLUE]"      "[/ color]")  ;; 3rd level Brackets
  ("[color =CYAN]"      "[/ color]")  ;; 4th level Brackets[/color]
  ("[color =#990099]"   "[/ color]")  ;; Multiline Comments
  ("[color =#990099]"   "[/ color]")  ;; Single Comments
  ("[color =#a52a2a]"   "[/ color]")  ;; Strings
  ("[color =BLUE]"      "[/ color]")  ;; Protected Symbols
  ("[color =#009900]"   "[/ color]")  ;; Integers
  ("[color =#009999]"   "[/ color]")  ;; Reals
)

As for the other discussion, I find N++ quite flexible when it goes to formatting with the indent by fold plugin. Also I've seen a

of a russian guy who auto-reloads the freshly modified code from N++ to ACAD (just like the VLIDE's console) - I have no idea how he managed to do that.
Link to comment
Share on other sites

But I still have to ask is it possible to configure the styles list to increment the brackets? I mean something like this:

'(
  ...
 [color=RED] ("[color =RED]"       "[/ color]")  ;; 1st level Brackets
  ("[color =GREEN]"     "[/ color]")  ;; 2nd level Brackets
  ("[color =BLUE]"      "[/ color]")  ;; 3rd level Brackets
  ("[color =CYAN]"      "[/ color]")  ;; 4th level Brackets
  ...
[/color] )

Not with the current code, but it would be possible to modify the program to accommodate this functionality.

Link to comment
Share on other sites

Not with the current code, but it would be possible to modify the program to accommodate this functionality.

You can consider it as an idea. :)

 

EDIT:

I've opened to check it - the amount of arguments, variables and brackets blew me away.

Edited by Grrr
Link to comment
Share on other sites

I'm guessing the LSP2HTML started in 2001. LSP2BBC 2005 and modified 2009 .

 

 

Just a reminder that this only works forum message areas.

 

As a test to see what test.lsp converted to html format looks like

 

<PRE><TT><FONT COLOR="FFFFFF">
<FONT COLOR="FFFFFF">   1| </FONT>(</FONT><FONT COLOR="FF9900">defun</FONT> </FONT><FONT COLOR="FFFFFF">c:test </FONT><FONT COLOR="FF00FF">() 
<FONT COLOR="FF00FF">   2| </FONT>  (</FONT><FONT COLOR="FF9900">setq</FONT> </FONT><FONT COLOR="FFFFFF">*error* nil</FONT><FONT COLOR="FF00FF">) 
<FONT COLOR="FF00FF">   3| </FONT>  (</FONT><FONT COLOR="FF9900">setq</FONT> </FONT><FONT COLOR="FFFFFF">a 
<FONT COLOR="0000FF">   4| </FONT>    </FONT><FONT COLOR="0000FF">(</FONT><FONT COLOR="FF9900">setq</FONT> </FONT><FONT COLOR="FFFFFF">b 
<FONT COLOR="00FFFF">   5| </FONT>      </FONT><FONT COLOR="00FFFF">(</FONT><FONT COLOR="FF9900">setq</FONT> </FONT><FONT COLOR="FFFFFF">c 
<FONT COLOR="00FF00">   6| </FONT>        </FONT><FONT COLOR="00FF00">(</FONT><FONT COLOR="FF9900">setq</FONT> </FONT><FONT COLOR="FFFFFF">d </FONT><FONT COLOR="FFFF00">(</FONT><FONT COLOR="FF9900">substr</FONT> </FONT><FONT COLOR="FFFFFF">1 1 1</FONT><FONT COLOR="FFFF00">)</FONT><FONT COLOR="00FF00">)</FONT><FONT COLOR="00FFFF">)</FONT><FONT COLOR="0000FF">)</FONT><FONT COLOR="FF00FF">) 
<FONT COLOR="FF00FF">   7| </FONT>  </FONT><FONT COLOR="FFFFFF">)  
</FONT></PRE></TT>

-David

LSP2BBC.LSP

Link to comment
Share on other sites

N++ will retain tab characters which are already present, but it does also provide the option to convert these to spaces under: Edit > Blank Operations > TAB to Space.

 

You can avoid inserting tabs when writing code by going to Settings > Preferences > Tab Settings > [Default] and ensure Replace by space is ticked.

 

 

Thanks ! I figured it was there some where, Just never found them. N++'s peer to peer community ( Gitter ) is pretty weak.

 

Thanks! -David

Link to comment
Share on other sites

David,

This thing is awesome, thanks alot!

 

I've just tested it on my previous example:

[b][color=BLACK]([/color][/b]if
[b][color=FUCHSIA]([/color][/b]and [color=#8b4513]; Evaluate arguments from user within the [color=#2f4f4f]"and"[/color] function[/color]
	[b][color=NAVY]([/color][/b]if
		[b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]Stuff to do #1 [b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nTheres something wrong in #1 try again!"[/color][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]Stuff to do #1 [b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if
		[b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]Stuff to do #2 [b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nTheres something wrong in #2 try again!"[/color][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]Stuff to do #2 [b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if
		[b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]Stuff to do #3 [b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nTheres something wrong in #3 try again!"[/color][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]Stuff to do #3 [b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; All arguments are evaluated, the code proceeds[/color]
[b][color=FUCHSIA]([/color][/b]while somethingisdone [color=#8b4513]; example: a selection was made and the same must be copied or moved within the while loop[/color]
	[b][color=NAVY]([/color][/b]progn
		[b][color=MAROON]([/color][/b]while 
			[b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]setq pickline [b][color=RED]([/color][/b]entsel [color=#2f4f4f]"\nPick a line"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			pickline
			[b][color=GREEN]([/color][/b]cond
				[b][color=BLUE]([/color][/b]   [b][color=RED]([/color][/b]= 7 [b][color=PURPLE]([/color][/b]getvar 'errno[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
					[b][color=RED]([/color][/b]princ [color=#2f4f4f]"\nYou must select a line."[/color][b][color=RED])[/color][/b]
				[b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]   [b][color=RED]([/color][/b]null pickline[b][color=RED])[/color][/b]
					[b][color=RED]([/color][/b]princ [color=#2f4f4f]"\nYou missed, try again."[/color][b][color=RED])[/color][/b]
				[b][color=BLUE])[/color][/b]
			[b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b][color=#8b4513]; to exit this loop and continue a line must be picked[/color]
		[b][color=MAROON]([/color][/b]We got everything we need from Stuff #1, #2 and #3, now the code does its job... [b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b][color=#8b4513]; the code did its job, exiting with my favourite ESC key, and don't forget the error handling if needed![/color]
[b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b][color=#8b4513];if[/color]

I don't think that with this type of formatting it can get any further! :)

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...