Author Topic: New Lisp any suggestions are welcomed  (Read 19759 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1420
New Lisp any suggestions are welcomed
« on: October 21, 2010, 03:52:16 AM »
This is a new lisp
Any suggestions are welcome
Sorry for native language its explanation of the lisp
Code: [Select]
;|-------------------Layers List----------------------
                q_|_|| _\|| q_|| _\|                 
                                                     
  يقوم بتحديد ميل الخط من خلال اختيار نقطتين عليه     
                   و من الممكن ان يختار المستخدم     
                بين ان يرسم خط بين النقطتين او لا     
                                                     
------------------------------------------------------
  Author: Hasan M. Asous, 2010                       
  Copyright © 2010 by HasanCAD, All Rights Reserved. 
  Contact: HasanCAD @ TheSwamp.org,                   
           asos2000 @ CADTutor.net                   
           HasanCAD@gmail.com                         
------------------------------------------------------
  Version: 1     20 Oct 2010                         
____________________________________________________|;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(defun c:TanLine (/ p1 p2 p3)
  ;Copyright © by HasanCAD
  (vl-load-com)

  (HSN:DDwnMnuSetSysVar)
 
  (and
    (setq doc (cond (doc) ((vla-get-ActiveDocument
   (vlax-get-Acad-Object)))))
    (setq spc (if (zerop (vla-get-activespace doc))
      (if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
                (vla-get-paperspace doc))
              (vla-get-modelspace doc)))

    (setq p1 (trans (getpoint "\nFirst Point اختار النقطة الاولى على الخط ")1 0))
    (setq p2 (trans (getpoint p1 "\nSecond Point اختار النقطة الثانية على الخط")1 0))
    (setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
    )

  (setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))

  (if (not TL-Line) (setq TL-Line "Yes"))
  (initget "Yes No")
  (setq TL-Line (cond ( (getkword (strcat "\nChoose هل تريد رسم خط بين النقطتين [Yes/No] <" TL-Line ">: ") ) ) ( TL-Line ) ))
  (if (equal TL-Line "Yes")
    (progn
      (HSN:TL-Text)
      (HSN:TL-Line)
      )
    (progn
      (HSN:TL-Text)
      )
    )
  (HSN:ReDDwnMnuSetSysVar)
  (vla-EndUndoMark ActDoc)
  )

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;

(defun *error* (msg)
  (and uFlag (vla-EndUndoMark doc))
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
  )

(defun HSN:DDwnMnuSetSysVar ()
  ;Copyright © by HasanCAD
  (setq OldOS (getvar "osmode"))
  (setq OldDynmode (getvar "dynmode"))
  (setq OldDynprompt (getvar "dynprompt"))
 
  (setvar "osmode" 33)
  (setvar "dynmode" 1)
  (setvar "dynprompt" 1)
  (setvar "cmdecho" 0)       
  )

(defun HSN:ReDDwnMnuSetSysVar ()
  ;Copyright © by HasanCAD
  (setq *error* TERR$)
  (setvar "osmode" OldOS)
  (setvar "dynmode" OldDynmode)
  (setvar "dynprompt" OldDynprompt)
  )

(defun HSN:TL-Text ()
  ;Copyright © by HasanCAD
       (entmakex (list
   (cons 0 "TEXT")
                   (cons 10  p3)
                   (cons 40 2.2)
                   (cons 1  (strcat (rtos (* tan2 100)) "%"))
   ))
  )

(defun HSN:TL-Line ()
  ;Copyright © by HasanCAD
       (entmake (list
  (cons 0 "LINE")
                  (cons 10 p1)
                  (cons 11 p2)
  ))
  )

;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;

(princ "\n  TanLine.lsp ~ Copyright © by HasanCAD")
(princ "\n     ...Type TanLine to Invoke...   ")
(princ)

jvillarreal

  • Bull Frog
  • Posts: 332
Re: New Lisp any suggestions are welcomed
« Reply #1 on: October 21, 2010, 10:34:23 AM »
It doesn't restore variables at error.
You need to add (HSN:ReDDwnMnuSetSysVar) to your error function.

Your'e using endundomark at the end of your routine without starting one at the beginning and using the variable ActDoc which is causing an error.
« Last Edit: October 21, 2010, 10:42:42 AM by jvillarreal »

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: New Lisp any suggestions are welcomed
« Reply #2 on: October 21, 2010, 12:00:06 PM »
This is a new lisp
Any suggestions are welcome
Sorry for native language its explanation of the lisp
Code: [Select]
(defun *error* (msg)
  (and uFlag (vla-EndUndoMark doc))
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
  )


I liked this part of codes. Can I use it with my future routines ?

Good luck


Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: New Lisp any suggestions are welcomed
« Reply #3 on: October 21, 2010, 12:10:27 PM »
This is a new lisp
Any suggestions are welcome
Sorry for native language its explanation of the lisp
Code: [Select]
(defun *error* (msg)
  (and uFlag (vla-EndUndoMark doc))
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
  )


I liked this part of codes. Can I use it with my future routines ?

Good luck



Its just a shame that it won't work as uFlag is never initiated in the first place... yet another block of code blindly copied from one of my programs...

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: New Lisp any suggestions are welcomed
« Reply #4 on: October 21, 2010, 12:33:06 PM »
This is a new lisp
Any suggestions are welcome
Sorry for native language its explanation of the lisp
Code: [Select]
(defun *error* (msg)
  (and uFlag (vla-EndUndoMark doc))
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
  )
I liked this part of codes. Can I use it with my future routines ?
Good luck

Its just a shame that it won't work as uFlag is never initiated in the first place... yet another block of code blindly copied from one of my programs...

Undoubtly. I do know that codes very well, and that's why I indicated to. But I did not expect that prompt of action.   :lol:

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: New Lisp any suggestions are welcomed
« Reply #5 on: October 21, 2010, 12:53:56 PM »
With all the code you have out there, better get used to it Lee.  :-)

Maybe this would be better:
Code: [Select]
(defun *error* (msg)
  (if (= 8 (logand 8 (getvar 'UNDOCTL)))
    (or (and doc (vla-EndUndomark doc))
        (and *doc* (vla-EndUndomark *doc*)))) ;LeeMac
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
)
« Last Edit: October 21, 2010, 12:59:14 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: New Lisp any suggestions are welcomed
« Reply #6 on: October 21, 2010, 01:02:07 PM »
Maybe this would be better.
Code: [Select]
(defun *error* (msg)
  (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-get-activedocument (vlax-get-acad-object))) ;LeeMac
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: New Lisp any suggestions are welcomed
« Reply #7 on: October 21, 2010, 01:09:54 PM »
With all the code you have out there, better get used to it Lee.  :-)

Yeah, I suppose...

LE3

  • Guest
Re: New Lisp any suggestions are welcomed
« Reply #8 on: October 21, 2010, 01:30:16 PM »
With all the code you have out there, better get used to it Lee.  :-)

Yeah, I suppose...

just my two pesos worth of nothing...  :evil:

sooner or later some lines of code will end up looking the same... what i see is that he is copying your headers, notes and annotation style - but if you see that from the other side, it is good for you, because you are making an standard for someone to follow - now if end up being an exact clone of your own stuff, then is another story...

ok, let's drop some other two pesos if i may.... :)

...
« Last Edit: October 25, 2010, 09:07:26 PM by LE »

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: New Lisp any suggestions are welcomed
« Reply #9 on: October 21, 2010, 02:00:46 PM »
My 2 cents,

(wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") won't work with me ("Fonction annulée" "quitter / sortir abandon") :evil:

IMO there's no need for 'uFlag' or (= 8 (logand 8 (getvar 'UNDOCTL))), you can run 'vla-EndUndomark' even is there wasn't any vla-StartUndomark before.
Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: New Lisp any suggestions are welcomed
« Reply #10 on: October 21, 2010, 07:10:59 PM »
Perhaps I am miss remembering the situation.
What I remember is when you open a drawing and do nothing but execute a vla-EndUndomark it causes an error.

No time to test it, on the way out. :-(
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

m4rdy

  • Newt
  • Posts: 62
Re: New Lisp any suggestions are welcomed
« Reply #11 on: October 21, 2010, 11:08:04 PM »
Code: [Select]
(defun HSN:DDwnMnuSetSysVar ()
 [color=red][b] ;Copyright © by HasanCAD[/b][/color]
   ...........
  )

(defun HSN:ReDDwnMnuSetSysVar ()
  [color=red][b];Copyright © by HasanCAD[/b][/color]
  .....................
  )

(defun HSN:TL-Text ()
  [color=red][b];Copyright © by HasanCAD[/b][/color]
       ..................
  )

(defun HSN:TL-Line ()
 [color=red][b] ;Copyright © by HasanCAD[/b][/color]
       ...............................
  )

I think i have to read  http://en.wikipedia.org/wiki/Copyright first before i use ('copy') some of that 'familiar' subroutine. :|
Autocad 2007, Windows XP

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: New Lisp any suggestions are welcomed
« Reply #12 on: October 22, 2010, 01:19:08 AM »
This is a new lisp
Any suggestions are welcome
Sorry for native language its explanation of the lisp
Code: [Select]
(defun *error* (msg)
  (and uFlag (vla-EndUndoMark doc))
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
  )


I liked this part of codes. Can I use it with my future routines ?

Good luck



Its just a shame that it won't work as uFlag is never initiated in the first place... yet another block of code blindly copied from one of my programs...
You have to understand Lee, most of the LISPers here are production people and learned to code out of necessity. As a result, the mentality is more about getting it to work, rather than the learning what everything does. When I first started coding, I blindly took subroutines/code segments and used them without knowing exactly how they worked. Not because I didn't care or wasn't smart enough to figure it out, it was because I had more pressing matters to worry about: making deadlines and just cutting a routine that will turn X steps into one in a minimal amount of time or perform that difficult/impossible task without a little code. Sadly, most don't have the luxury to learn it properly, from the bottom up and just pick up what they need at that moment.
Do not take this as an attack, I just want you to have an idea as to why some just 'take' code and use it. They know it works because they see it does or a reliable source told them it would; not every line is understood, but eventually it will be.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

pkohut

  • Bull Frog
  • Posts: 483
Re: New Lisp any suggestions are welcomed
« Reply #13 on: October 22, 2010, 01:52:39 AM »
Code: [Select]
(defun HSN:TL-Line ()
  ;Copyright © by HasanCAD
       (entmake (list
  (cons 0 "LINE")
                  (cons 10 p1)
                  (cons 11 p2)
  ))
  )
I think i have to read  http://en.wikipedia.org/wiki/Copyright first before i use ('copy') some of that 'familiar' subroutine. :|


Yep, surprised it's taken this long for someone to bring it up. Think I might have stomped on his copyright claim 20 or so years ago.
New tread (not retired) - public repo at https://github.com/pkohut

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: New Lisp any suggestions are welcomed
« Reply #14 on: October 22, 2010, 05:03:50 AM »
Let's try another way

HasanCAD,

What does the Copyright notice mean to you ??
 
 
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.