[编程交流] “ID”c的自动化

[color=GREEN];; Integration Demonstration  -  Lee Mac[/color]
([color=BLUE]defun[/color] c:integrate ( [color=BLUE]/[/color] *error* axs crv csv des dis inc int lst num obj pt1 rtn tmp )
   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] tmp)) ([color=BLUE]entget[/color] tmp)) ([color=BLUE]entdel[/color] tmp))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'file ([color=BLUE]type[/color] des)) ([color=BLUE]close[/color] des))
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg [color=BLUE]t[/color]) [color=MAROON]"*break,*cancel*,*exit*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )
   
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] crv (integrate:select [color=MAROON]"\nSelect curve to 'integrate': "[/color]))
            ([color=BLUE]setq[/color] axs (integrate:select [color=MAROON]"\nSelect axis: "[/color]))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]initget[/color] 6)
           ([color=BLUE]setq[/color] num ([color=BLUE]cond[/color] (([color=BLUE]getint[/color] [color=MAROON]"\nSpecify number of divisions <10>: "[/color])) (10))
                 dis ([color=BLUE]vlax-curve-getdistatparam[/color] axs ([color=BLUE]vlax-curve-getstartparam[/color] axs))
                 inc ([color=BLUE]/[/color] ([color=BLUE]-[/color] ([color=BLUE]vlax-curve-getdistatparam[/color] axs ([color=BLUE]vlax-curve-getendparam[/color] axs)) dis) num)
                 obj ([color=BLUE]vlax-ename->vla-object[/color] crv)
           )
           ([color=BLUE]repeat[/color] ([color=BLUE]1+[/color] num)
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pt1 ([color=BLUE]vlax-curve-getpointatdist[/color] axs dis))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] tmp
                           ([color=BLUE]entmakex[/color]
                               ([color=BLUE]list[/color]
                                  '(0 . [color=MAROON]"LINE"[/color])
                                   ([color=BLUE]cons[/color] 10 pt1)
                                   ([color=BLUE]cons[/color] 11
                                       ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] pt1
                                           (   ([color=BLUE]lambda[/color] ( v ) ([color=BLUE]list[/color] ([color=BLUE]-[/color] ([color=BLUE]cadr[/color] v)) ([color=BLUE]car[/color] v)))
                                               ([color=BLUE]vlax-curve-getfirstderiv[/color] axs ([color=BLUE]vlax-curve-getparamatdist[/color] axs dis))
                                           )
                                       )
                                   )
                               )
                           )
                       )
                       ([color=BLUE]if[/color]
                           ([color=BLUE]setq[/color] int
                               ([color=BLUE]vlax-invoke[/color] obj 'intersectwith
                                   ([color=BLUE]vlax-ename->vla-object[/color] tmp) [color=BLUE]acextendotherentity[/color]
                               )
                           )
                           ([color=BLUE]progn[/color]
                               ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]distance[/color] pt1 int) lst))
                               ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) '(62 .  ([color=BLUE]cons[/color] 10 pt1) ([color=BLUE]cons[/color] 11 int)))
                           )
                       )
                       ([color=BLUE]entdel[/color] tmp)
                   )
               )
               ([color=BLUE]setq[/color] dis ([color=BLUE]+[/color] dis inc))
           )
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst))
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] csv ([color=BLUE]vl-filename-mktemp[/color] [color=MAROON]"int"[/color] ([color=BLUE]getvar[/color] 'dwgprefix) [color=MAROON]".csv"[/color]))
                        ([color=BLUE]setq[/color] des ([color=BLUE]open[/color] csv [color=MAROON]"w"[/color]))
                   )
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]write-line[/color] [color=MAROON]"Length 1,Length 2,Segment Width,Segment Area"[/color] des)
                       ([color=BLUE]setq[/color] rtn
                           ([color=BLUE]mapcar[/color]
                              '([color=BLUE]lambda[/color] ( a b [color=BLUE]/[/color] x )
                                   ([color=BLUE]write-line[/color]
                                       ([color=BLUE]strcat[/color]
                                           ([color=BLUE]rtos[/color] a 2 3) [color=MAROON]","[/color]
                                           ([color=BLUE]rtos[/color] b 2 3) [color=MAROON]","[/color]
                                           ([color=BLUE]rtos[/color] inc 2 3) [color=MAROON]","[/color]
                                           ([color=BLUE]rtos[/color] ([color=BLUE]setq[/color] x ([color=BLUE]*[/color] inc 0.5 ([color=BLUE]+[/color] a b))) 2 3)
                                       )
                                       des
                                   )
                                   x
                               )
                               lst ([color=BLUE]cdr[/color] lst)
                           )
                       )
                       ([color=BLUE]write-line[/color] [color=MAROON]""[/color] des)
                       ([color=BLUE]write-line[/color] ([color=BLUE]strcat[/color] [color=MAROON]",,Total Area:,"[/color] ([color=BLUE]rtos[/color] ([color=BLUE]apply[/color] '[color=BLUE]+[/color] rtn) 2 3)) des)
                       ([color=BLUE]setq[/color] des ([color=BLUE]close[/color] des))
                       ([color=BLUE]if[/color] ([color=BLUE]findfile[/color] csv) ([color=BLUE]startapp[/color] [color=MAROON]"explorer"[/color] csv))
                   )
                   ([color=BLUE]princ[/color] [color=MAROON]"\nUnable to generate CSV file."[/color])
               )
               ([color=BLUE]princ[/color] [color=MAROON]"\nNo intersection data found."[/color])
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] integrate:select ( msg [color=BLUE]/[/color] ent )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] msg)))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]null[/color] ent)
                   [color=BLUE]nil[/color]
               )
               (   ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] ent)))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid object selected."[/color])
               )
           )
       )
   )
   ent
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])