Jump to content

Lisp routine for data to ascii

bsimpson

By bsimpson
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

bsimpson Enthusiast

bsimpson

Posted
Posted

Hi,

 

I am trying to extract data in AutoCAD 2010 of a number of drawn lines.

 

The data needed is their lengths. Can someone write a lisp routine for their lengths extraction to an ascii file? or point out one that is already written.

 

the list command gives too much extracted data and can only list a certain amount of objects per screen.

 

The resultant ascii file needed is;

 

lengths

100.001

120.002

234.980

 

Thanks

 

PS

It would be good if a lisp routine could extract other elements from the data of objects for instance their colour.

 

Can a routine be made for the future with a combo box of the properties of the objects that can be saved to an ascii file?

Lee Mac Grand Master

Lee Mac

Posted
Posted

I think this can do all but length... :P

http://www.cadtutor.net/forum/showthread.php?t=42954

bsimpson Enthusiast

bsimpson

Posted
  • Author
Posted

Thanks for the info LEE.

 

I may need a special here. The lisp routine shown adds all the lenghts of the lines in a layer. What I need is a lisp that will list the line lenghts in an ascii file. e.g.

 

Lengths

23.45

45.67

67.89

 

The reason is I need the extracted lengths of the lines for a geometrics design program.

 

Thanks

Lee Mac Grand Master

Lee Mac

Posted
Posted

Give this a shot;

 

(defun c:GetLens (/ ss i ent e)
 (vl-load-com)

 (if (and (setq f (getfiled "Output" "" "txt" 9))
          (setq i -1 ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))))
   (progn
     (setq f (open f "a"))

     (while (setq ent (ssname ss (setq i (1+ i))))
       (if (setq e (vlax-curve-getEndParam ent))
         (write-line (rtos (vlax-curve-getDistatParam ent e)) f)))

     (close f)))

 (princ))

bsimpson Enthusiast

bsimpson

Posted
  • Author
Posted

Hi Lee,

 

This is fantastic and exactly the right thing. However I need to finalize the project and combine this lisp with another one (shown below).

 

The other one is a routine that draws perpendicular lines from a primary line to second line with a space between them.

 

See if you can improve the lisp I have with the Lisp you have created

 

Thanks a million.

 

(defun c:test (/

*error*

EntName1

EntName2

EndDist

IntersList

Point

StartDist

Step

TempEnt

VlaObj1

VlaObj2

)

(defun *error* (msg)

(if TempEnt

(entdel TempEnt)

)

(princ)

)

(if (and (setq EntName1 (car (entsel "\nSelect primary line: ")))

(setq EntName2 (car (entsel "\nSelect secondary line: ")))

(setq Step (getdist "\nEnter step: "))

(> Step 0.0)

)

(progn (setq VlaObj1 (vlax-ename->vla-object EntName1)

VlaObj2 (vlax-ename->vla-object EntName2)

StartDist 0.0

EndDist (vlax-curve-getDistAtParam VlaObj1 (vlax-curve-getEndParam VlaObj1))

)

(while (

(setq Point (vlax-curve-getPointAtDist VlaObj1 StartDist))

(if (not (vl-catch-all-error-p

(setq IntersList

(vl-catch-all-apply

'vlax-safearray->list

(list (vlax-variant-value

(vla-IntersectWith

(vlax-ename->vla-object

(setq TempEnt

(entmakex

(list

(cons 0 "LINE")

(cons 10 Point)

(cons

11

(polar

Point

(- (angle

(vlax-curve-getFirstDeriv

VlaObj1

(vlax-curve-getParamAtDist

VlaObj1

StartDist

)

)

(list 0.0 0.0)

)

(/ pi 2)

)

1.0

)

)

)

)

)

)

VlaObj2

acExtendThisEntity

)

)

)

)

)

)

)

(entmake

(list (cons 0 "LINE")

(cons 10 Point)

(list 11 (car IntersList) (cadr IntersList) (caddr IntersList))

)

)

)

(entdel TempEnt)

(setq StartDist (+ StartDist Step))

)

)

)

(princ)

)

 

(princ))

 

[/code]

Lee Mac Grand Master

Lee Mac

Posted
Posted 
[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:test  [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] *error* DOC E1 E2 EDIS FILE ILST L LLST OBJ2 OFILE PA PT SDIS SPC TMP[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [i][color=#990099];; Lee Mac  ~  24.03.10[/color][/i]
 
 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error*  [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] tmp   [b][color=RED]([/color][/b][b][color=BLUE]entdel[/color][/b] tmp[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]close[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]


 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] isCurveObj [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-error-p[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-apply[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vlax-curve-getEndParam[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]


 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] line [b][color=RED]([/color][/b]p1 p2[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]entmakex[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#a52a2a]"LINE"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b] p1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]11[/color][/b] p2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]     
 

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] spc  [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]AcModelSpace [/color][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSpace[/color][/b]
                                       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
                                                   [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                    
                    [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b]   [b][color=RED]([/color][/b][b][color=BLUE]vla-get-MSpace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
              
              [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ModelSpace[/color][/b] doc[b][color=RED])[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]vla-get-PaperSpace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] *step* [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *step* [b][color=#009999]10.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]  

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]and[/color][color=RED])[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
                [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x s[b][color=RED])[/color][/b]
                            [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b]
                              [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
                                [b][color=RED]([/color][/b][b][color=BLUE]set[/color][/b] x [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] s[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                
                                [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=DARKRED]'[/color][/b]ENAME [b][color=RED]([/color][/b][b][color=BLUE]type[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eval[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                       
                                       [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b]isCurveObj [b][color=RED]([/color][/b][b][color=BLUE]eval[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                         [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** Invalid Object Selected **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                
                [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b]e1 e2[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#a52a2a]"\nSelect PRIMARY line: "[/color][/b] [b][color=#a52a2a]"\nSelect SECONDARY line: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

              [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] file [b][color=RED]([/color][/b][b][color=BLUE]getfiled[/color][/b] [b][color=#a52a2a]"Output File"[/color][/b] [b][color=#a52a2a]""[/color][/b] [b][color=#a52a2a]"txt"[/color][/b] [b][color=#009900]9[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]initget[/color][/b] [b][color=#009900]6[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *step* [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]getdist[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\nSpecify Step <"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] *step*[b][color=RED])[/color][/b] [b][color=#a52a2a]"> : "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]*step*[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

           sDis   [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatParam[/color][/b] e1
                       [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getStartParam[/color][/b] e1[b][color=RED])[/color][/b][b][color=RED])[/color][/b] *step*[b][color=RED])[/color][/b]

           eDis   [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatParam[/color][/b] e1
                    [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getEndParam[/color][/b] e1[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] set[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b]obj1 obj2[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vlax-ename->vla-object[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] e1 e2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     

     [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] sDis [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] sDis *step*[b][color=RED])[/color][/b][b][color=RED])[/color][/b] eDis[b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pa [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getParamatDist[/color][/b] e1 sDis[b][color=RED])[/color][/b]
             pt [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getPointatDist[/color][/b] e1 sDis[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             

       [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] iLst [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b]
                          [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b]
                            [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tmp
                              [b][color=RED]([/color][/b]Line pt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b]
                                                    [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getFirstDeriv[/color][/b] e1 pa[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009999]1.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                        
                          [b][color=DARKRED]'[/color][/b]IntersectWith Obj2 [b][color=Blue]acExtendThisEntity[/color][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entdel[/color][/b] tmp[b][color=RED])[/color][/b]
             iLst[b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lLst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatParam[/color][/b]
                            [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] l [b][color=RED]([/color][/b]Line pt [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] iLst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] iLst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caddr[/color][/b] iLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                            [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getEndParam[/color][/b] l[b][color=RED])[/color][/b][b][color=RED])[/color][/b] lLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]open[/color][/b] file [b][color=#a52a2a]"a"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]write-line[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] x[b][color=RED])[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lLst[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ofile [b][color=RED]([/color][/b][b][color=BLUE]close[/color][/b] ofile[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

bsimpson Enthusiast

bsimpson

Posted
  • Author
Posted

Hi Lee,

 

This is brilliant. I am happy with this version however when I showed it to someone else they questioned the data output of the increment .

 

Ideally I will keep this version for myself as I can mentally work out the increment value. For them can we export the data to ascii with the increment. e.g.

 

increment and length

 

0; 10.78

10; 21.56

20; 32.78

30; 89.97

e.t.c

 

 

Thanks

fixo Mentor

fixo

Posted
Posted
Hi Lee,

 

This is brilliant. I am happy with this version however when I showed it to someone else they questioned the data output of the increment .

 

Ideally I will keep this version for myself as I can mentally work out the increment value. For them can we export the data to ascii with the increment. e.g.

 

increment and length

 

0; 10.78

10; 21.56

20; 32.78

30; 89.97

e.t.c

 

 

Thanks

 

Try slightly edited code

 

(defun c:test  (/
 *error*
 EntName1
 EntName2
 EndDist
 IntersList
 Point
 StartDist
 Step
 TempEnt
 VlaObj1
 VlaObj2
 dist
 filedesc
 filename
 out_list
 strline
 )
 (defun *error*  (msg)
   (if TempEnt
     (entdel TempEnt)
     )
   (princ)
   )
 (if (and (setq EntName1 (car (entsel "\nSelect primary line: ")))
   (setq EntName2 (car (entsel "\nSelect secondary line: ")))
   (setq Step (getdist "\nEnter step: "))
   (> Step 0.0)
   )
   (progn (setq VlaObj1   (vlax-ename->vla-object EntName1)
  VlaObj2   (vlax-ename->vla-object EntName2)
  StartDist 0.0
  EndDist   (vlax-curve-getDistAtParam
       VlaObj1
       (vlax-curve-getEndParam VlaObj1))
  )
   (while (< StartDist EndDist)
     (setq Point (vlax-curve-getPointAtDist VlaObj1 StartDist))
     (if (not (vl-catch-all-error-p
  (setq IntersList
         (vl-catch-all-apply
    'vlax-safearray->list
    (list (vlax-variant-value
     (vla-IntersectWith
       (vlax-ename->vla-object
         (setq TempEnt
         (entmakex
           (list
      (cons 0 "LINE")
      (cons 10 Point)
      (cons
        11
        (polar
          Point
          (- (angle
        (vlax-curve-getFirstDeriv
          VlaObj1
          (vlax-curve-getParamAtDist
            VlaObj1
            StartDist
            )
          )
        (list 0.0 0.0)
        )
             (/ pi 2)
             )
          1.0
          )
        )
      )
           )
        )
         )
       VlaObj2
       acExtendThisEntity
       )
     )
          )
    )
        )
  )
       )
       (progn
  (entmake
    (list (cons 0 "LINE")
   (cons 10 Point)
   (list 11
         (car IntersList)
         (cadr IntersList)
         (caddr IntersList))
   )
    )
  (setq dist (distance Point
         (list (car IntersList)
        (cadr IntersList)
        (caddr IntersList)))
        )
  (setq strline (strcat (rtos StartDist 2 0) ";" (rtos dist 2 2)))
  (setq out_list (cons strline out_list))
  )
       )
     (entdel TempEnt)
     (setq StartDist (+ StartDist Step))
     )
     (if out_list
   (if (setq filename (getfiled "Road sections file" "C:\\" "txt" 9))
     (progn
(setq filedesc (open filename "a"))
     (foreach line  (reverse out_list)
(write-line line filedesc)
)
     )
   (close filedesc)
   )
   )
   )
   )
 (princ)
 )
(prompt "\nType TEST to execute")
(prin1)

 

~'J'~

Lee Mac Grand Master

Lee Mac

Posted
Posted

Perhaps this:

 

(defun c:test  (/ *error* DOC E1 E2 EDIS FILE ILST L LLST OBJ2 OFILE PA PT SDIS SPC TMP)
 (vl-load-com)
 ;; Lee Mac  ~  24.03.10
 
 (defun *error*  (msg)
   (and tmp   (entdel tmp))
   (and ofile (close ofile))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))


 (defun isCurveObj (x)
   (not (vl-catch-all-error-p
          (vl-catch-all-apply
            (function vlax-curve-getEndParam) (list x)))))


 (defun line (p1 p2)
   (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))     
 

 (setq spc  (if (or (eq AcModelSpace (vla-get-ActiveSpace
                                       (setq doc (vla-get-ActiveDocument
                                                   (vlax-get-acad-object)))))
                    
                    (eq :vlax-true   (vla-get-MSpace doc)))
              
              (vla-get-ModelSpace doc)
              (vla-get-PaperSpace doc)))
 

 (or *step* (setq *step* 10.))  

 (if (apply (function and)
            (append
              (mapcar
                (function (lambda (x s)
                            (while
                              (progn
                                (set x (car (entsel s)))
                                
                                (cond (  (eq 'ENAME (type (eval x)))
                                       
                                       (if (not (isCurveObj (eval x)))
                                         (princ "\n** Invalid Object Selected **")))))) x))
                
                '(e1 e2) '("\nSelect PRIMARY line: " "\nSelect SECONDARY line: "))

              (list (setq file (getfiled "Output File" "" "txt" 9)))))
   (progn
     (initget 6)
     (setq *step* (cond ((getdist (strcat "\nSpecify Step <" (rtos *step*) "> : "))) (*step*))

           sDis   (- (vlax-curve-getDistatParam e1
                       (vlax-curve-getStartParam e1)) *step*)

           eDis   (vlax-curve-getDistatParam e1
                    (vlax-curve-getEndParam e1)))

     (mapcar (function set) '(obj1 obj2)
             (mapcar (function vlax-ename->vla-object) (list e1 e2)))
     

     (while (<= (setq sDis (+ sDis *step*)) eDis)
       (setq pa (vlax-curve-getParamatDist e1 sDis)
             pt (vlax-curve-getPointatDist e1 sDis))
             

       (if (progn
             (setq iLst (vlax-invoke
                          (vlax-ename->vla-object
                            (setq tmp
                              (Line pt (polar pt (+ (angle '(0 0 0)
                                                    (vlax-curve-getFirstDeriv e1 pa)) (/ pi 2.)) 1.))))
                        
                          'IntersectWith Obj2 acExtendThisEntity)) (entdel tmp)
             iLst)

         (setq lLst (cons (cons sDis (vlax-curve-getDistatParam
                                       (setq l (Line pt (list (car iLst) (cadr iLst) (caddr iLst))))
                                       (vlax-curve-getEndParam l))) lLst))))

     (setq ofile (open file "a"))
     (mapcar
       (function
         (lambda (x)
           (write-line (strcat (rtos (car x)) ";" (rtos (cdr x))) ofile))) (reverse lLst))
     (setq ofile (close ofile))))

 (princ))

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.

×
 Share
Go to topic listing
×
×
  • Create New...