Author Topic: INCL-lisp  (Read 3147 times)

0 Members and 1 Guest are viewing this topic.

Fabricio28

  • Swamp Rat
  • Posts: 670
INCL-lisp
« on: October 17, 2012, 08:31:50 AM »
Hey all,
 I 'm trying to make this lisp better, insert the text in the midpoint.

Anybody Can help me help, please?

Thanks in advance

Code: [Select]
(defun c:incl(/ pv1 pv2 y1 y2 x1 x2 h l l1 i inc ang ang1 ptx1 texto)
 (command "layer" "s" "inclinação" "") 
  (SETQ pv1(getpoint "\nSaida:"))
   (SETQ pv2(getpoint "\nChegada:"))
   (SETQ Y1(NTH 1 PV1))
   (SETQ Y2(NTH 1 PV2))
   (SETQ X1(NTH 0 PV1))
   (SETQ X2(NTH 0 PV2))
   (SETQ H(- Y1 Y2))
   (SETQ L(- X2 X1))
   (SETQ L1(* 10 L))
   (SETQ I(/ H L1))
   (SETQ INC(RTOS I 2 4))
   (SETQ ANG (angle PV1 PV2))
   (SETQ ang1 (angtos ang 4 4))
   (SETQ PTXT1 (getpoint "\nInclinação:"))
   (SETQ TEXTO (Strcat "i=" INC))
   (command "text" "s" "incl" "c" PTXT1 ANG1 texto)
)

« Last Edit: October 17, 2012, 12:48:26 PM by FABRICIO28 »

d2010

  • Bull Frog
  • Posts: 326
Re: INCL-lisp
« Reply #1 on: October 19, 2012, 08:45:56 AM »
1) You downloading pp_fabricio28.fas
2) you enter the command C:Q2 or (Defun C:q2( /)
3) you open the drawing "testfabr.dwg"
4)if you need the 100%source autolisp please contact me....
5) the code cpp bellow it is converted to 100% autolispsource
 :x
Code - C++: [Select]
  1. /*c2s:
  2.        x1=nil,
  3.        y1=nil,
  4.        x2=nil,
  5.        y2=nil,
  6.        lnam=ACRX_T("inclinaçao");
  7.        if (dfn_layer_isexist(lnam)<1)
  8.            dfn_layer_new(lnam,7,0,nil);
  9.  
  10.        setvar("clayer",lnam);
  11.        pv1=getpoint("\nSaida:"),
  12.        if (dfn_var_ispoint(pv1))
  13.          x1=car(pv1),
  14.          Y1=cadr(pv1);
  15.         else
  16.          vl_exit_with_value("\nAcadstr::eInvalidDxf2dPoint");
  17.  
  18.  
  19.        pv2=getpoint(pv1,"\nChegada:");
  20.        if (dfn_var_ispoint(pv2))
  21.          x2=car(pv2),
  22.          Y2=cadr(pv2);
  23.         else
  24.          vl_exit_with_value("\nAcadstr::eInvalidDxf2dPoint");
  25.  
  26.        H= (Y1-Y2);
  27.        L= (X2-X1);
  28.        L1= (10*L);
  29.        I= (H/L1) ;
  30.        INC=rtos(I,2,4);
  31.        ANG=angle(PV1,PV2);
  32.        ang1=angtos(ang,4,4);
  33.        pmid=list((x1+x2)/2.0,(y1+y2)/2.0,0.0);
  34.        TEXTO=strcat("i=",INC);  
  35.        k1=dfn_enamk_text(pmid,nil,texto,"ML",ang,lnam,50,"");
  36. */
  37.  

Fabricio28

  • Swamp Rat
  • Posts: 670
Re: INCL-lisp
« Reply #2 on: October 19, 2012, 09:10:41 AM »
Dear d2010,
  Thanks for replay. Your program works perfect!
  I'm really appreciate that.

I'd like to share the excellent program from Tharwat.

Thanks Tharwat and d2010.

Regards

Code: [Select]
(defun c:incl (/ *error* pv1 pv2 p y1 y2 x1 x2 y1 y2)
  ;;; Tharwat Al Shoufi 17. Oct. 2012  ;;;
  (defun *error* (x) (princ "\n ...") (princ "\n *Cancel*"))
  (if (not (tblsearch "LAYER" "INCLINAÇÃO"))
    (entmakex '((0 . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (62 . 4)
                (2 . "INCLINAÇÃO")
                (70 . 0)
                (6 . "Continuous")
                (370 . -3)
               )
    )
  )
  (if (not (tblsearch "STYLE" "INCL"))
    (entmakex '((0 . "STYLE")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbTextStyleTableRecord")
                (2 . "INCL")
                (70 . 0)
                (40 . 0.175)
                (41 . 1.0)
                (50 . 0.0)
                (71 . 0)
                (42 . 0.175)
                (3 . "SIMPLEX.shx")
                (4 . "")
               )
    )
  )
  (if (setq pv1 (getpoint "\n Specify First point:"))
    (while (setq pv2 (getpoint "\n Next point:" pv1))
      (progn
        (setq y1 (cadr pv1))
        (setq y2 (cadr pv2))
        (setq x1 (car pv1))
        (setq x2 (car pv2))
        (entmakex
          (list
            '(0 . "TEXT")
            (cons 1
                  (strcat "i=" (rtos (/ (- y1 y2) (* 10 (- x2 x1))) 2 4))
            )
            '(40 . 0.175)
            '(7 . "INCL")
            '(8 . "INCLINAÇÃO")
            (cons 10
                  (setq p
                         (polar (mapcar '(lambda (p q) (/ (+ p q) 2.)) pv1 pv2)
                                (+ (angle pv1 pv2) (/ pi 2.))
                                0.05
                         )
                  )
            )
            (cons 11 p)
            (cons 50 (angle pv1 pv2))
            '(72 . 1)
            '(73 . 0)
          )
        )
      )
      (setq pv1 pv2)
    )
  )
(princ "\n Written by Tharwat Al Shoufi")
  (princ)
)
[\code]


Tharwat

  • Swamp Rat
  • Posts: 710
  • Hypersensitive
Re: INCL-lisp
« Reply #3 on: October 19, 2012, 11:59:39 AM »
I'd like to share the excellent program from Tharwat.

Thanks Tharwat and d2010.

Regards

You're very welcome .  :wink:

cadplayer

  • Bull Frog
  • Posts: 390
  • Autocad Civil3d, OpenDCL.Runtime, LISP, .NET (C#)
Re: INCL-lisp
« Reply #4 on: October 20, 2012, 04:54:37 AM »
Many bugs in compiler... I´m not realy understand to use it :cry:

d2010

  • Bull Frog
  • Posts: 326
Re: INCL-lisp
« Reply #5 on: September 19, 2014, 08:53:11 AM »
Many bugs in compiler... I´m not realy understand to use it :cry:

After  two years, i  fixed many bugs..
you make user -account and click-again on blue-string "inregistrare"
http://lisp2arx.3xforum.ro/post/22/1/DOWNLOADING_vlacompilator_Here_/
or  you open ,& open  after register first time......