Jump to content

Polyline to Excel Border

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Rising Star

exceed

Posted
Posted (edited)

  

; PLEX - 2022.05.30 exceed
; Polyline to Excel Border


(vl-load-com)
(defun c:PLEX ( / lengthlist getinterlist gilen index pixelstack r c xreturn pxslen pxsrow pxsrowlen pxscell continueanswer)
 
 ;(setq pixelstack (list (list (list 1 3) (list 1 3) (list 1 3) (list 1 3)) (list (list 1 3) (list 1 3) (list 1 3) (list 1 3))))
 (setq getinterlist (ex:getinter)) 
 ;(princ getinterlist)
 (setq gilen (length getinterlist))
 (setq index 0)
 ;(princ getinterlist)

 (ex:ESMAKE)
 ;(vlax-put-property xlcols 'ColumnWidth 0.77)
 (vlax-put-property xlcols 'ColumnWidth 1.88)
 ;(vlax-put-property xlrows 'RowHeight 7.5)
 (vlax-put-property xlrows 'RowHeight 15)

 (setq bordercolor 3)

 (repeat gilen
   (setq pixelstack (car (cdr (nth index getinterlist))))
   ;(princ "\n pixelstack - ")
   ;(princ pixelstack)
   (setq r 2)
   (setq c 2)
   (setq xreturn c)
   (setq pxslen (length pixelstack))
   (repeat pxslen
     (setq pxsrow (car pixelstack))
     (setq pxsrowlen (length pxsrow))
     (repeat pxsrowlen
       (setq pxscell (car pxsrow))
       ;(princ pxscell)
       (if (/= pxscell (list 0))
         (ex:ecborder r c pxscell 1 3 bordercolor)
       )
       (setq c (+ c 1))
       (setq pxsrow (cdr pxsrow))
     );end of repeat
     (setq listingx (+ c 3))
     (setq c xreturn)
     (setq r (+ r 1))
     (setq pixelstack (cdr pixelstack))
   );end of repeat




  (ex:ecborder (+ index 2) listingx (list 1 2 3 4 5 6) 1 3 bordercolor)

  (ex:ecsel (+ index 2) (+ listingx 1))
  (ex:ecput " : Length = ")
  (ex:ecsel (+ index 2) (+ listingx 2))
  (ex:ecput (vl-princ-to-string (car (nth index getinterlist)) ))
  (cond 
    ((< bordercolor 20) (setq bordercolor (+ bordercolor 1)))
    ((= bordercolor 20) (setq bordercolor 3))
  )
  ;(setq continueanswer (getstring "\n continue?"))
  (setq index (+ index 1))
 )

 

 (princ "\n")
 (princ index)
 (princ " Lines Complete ")


 
 (ex:releaseExcel)
 (princ)
)

(defun ex:ESMAKE ( )
 ;from BIGAL's ah:chkexcel
 (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 (vlax-put Excelapp "visible" :vlax-true)
 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq xlcols (vlax-get-property acsheet 'Columns))
 (setq xlrows (vlax-get-property acsheet 'Rows))
 (setq cell (vlax-get-property acsheet 'Cells))
)

(defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)


 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (if (> c2 0)
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
       (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
     )
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (if (> c3 0)
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
     )
   );end of cond option 3
 );end of cond

 (setq rng (vlax-get-property acsheet 'Range addr))
 (vlax-invoke rng 'Select)


 (princ)
)

(defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq textstring2 (strcat "'" textstring))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (if (> c2 0)
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
       (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
     )
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (if (> c3 0)
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
     )
   );end of cond option 3
 );end of cond

 (setq c (+ c 1))

 (vlax-put-property cell 'item r c textstring2)

 (princ)
)


(defun ex:ECBORDER ( r c brdi ltype lweight lcolor )

 (setq c (- c 1))
 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (if (> c2 0)
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
       (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
     )
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (if (> c3 0)
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
       (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
     )
   );end of cond option 3
 );end of cond

 (setq rng (vlax-get-property acsheet 'Range addr))
 (setq brds (vlax-get-property rng 'borders))
 (foreach i brdi
   (setq tmp (vlax-get-property brds 'Item i))
   (if lweight
     (vlax-put-property tmp 'Weight lweight)
   )
   (if ltype
     (vlax-put-property tmp 'LineStyle ltype)
   )
   (if lcolor
     (vlax-put-property tmp 'ColorIndex lcolor)
   )
 )
 (vlax-invoke rng 'Select)
)


(defun ex:getinter ( / mspace dividerinput p1 p2 p3 p4 xmax xmin ymax ymin startpt endpt recsize xcount ycalc ycount returnx returny sspl plindex sspllen outborderstack plselected plobj yindex outbordercolumn xindex outborderrow rec1 rec2 rec3 rec4 ptlist recptlist rec tmp outputlist interlist interlistlen interlistindex recdist recmin outborder plobjlisting plobjstartpt plobjendpt plobjlength )
  (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  ;(setq dividerinput 10)
  (initget 7)
  (setq dividerinput (getint "\n Input number of excel column you want "))


  (if
    (and
      (setq p1 (getpoint "\n Select Range - Start Point "))
      (setq p3 (getcorner p1 "\n Select Range - End Point "))
    )
    (progn
      (setq p2 (list (car p3) (cadr p1))
             p4 (list (car p1) (cadr p3))
      )
      (grvecs (list -1 p1 p2 p2 p3 p3 p4 p4 p1))
    )
  )
  (redraw)
  (princ)

  (cond
    ((>= (car p1) (car p3)) (setq xmax (car p1)) (setq xmin (car p3)))
    ((< (car p1) (car p3)) (setq xmax (car p3)) (setq xmin (car p1)))
  )
  (cond
    ((>= (cadr p1) (cadr p3)) (setq ymax (cadr p1)) (setq ymin (cadr p3)))
    ((< (cadr p1) (cadr p3)) (setq ymax (cadr p3)) (setq ymin (cadr p1)))
  )

  (setq startpt (list xmin ymax 0.0))
  (setq endpt (list xmax ymin 0.0))
  (setq recsize (/ (- xmax xmin) dividerinput))
  (setq xcount dividerinput)
  (setq ycalc (/ (- ymax ymin) recsize))
  (cond
    ((= (fix ycalc) ycalc) (setq ycount (fix ycalc)))
    ((/= (fix ycalc) ycalc) (setq ycount (+ (fix ycalc) 1)))
  )

  (setq returnx (car startpt))
  (setq returny (cadr startpt))

  (setq sspl (ssget "C" startpt endpt '((0 . "LWPOLYLINE"))))
  (setq plindex 0)
  (setq sspllen (sslength sspl))
  (setq outborderstack '())
  (repeat sspllen
    (setq plselected (ssname sspl plindex))
    (setq plobj (vlax-ename->vla-object plselected))
    
    (setq plobjlength (vlax-get-property plobj 'Length))
    ;(princ plobjlength)

    (if (> plobjlength (/ recsize 2))
      (progn
    
    (setq plobjlisting (vlax-safearray->list (vlax-variant-value (vlax-get-property plobj 'Coordinates))))
    (setq plobjstartpt (list (car plobjlisting) (cadr plobjlisting) 0.0))
    (setq plobjendpt (list (nth (- (length plobjlisting) 2) plobjlisting) (last plobjlisting) 0.0))
    ;(princ plobjstartpt)
    ;(princ plobjendpt)

    (setq yindex 0)
    (setq outbordercolumn '())
    (repeat ycount
      (setq xindex 0)
      (setq outborderrow '())
      (repeat xcount
        (setq rec1 (list (car startpt) (- (cadr startpt) recsize) 0.0))
        (setq rec2 (list (+ (car startpt) recsize) (- (cadr startpt) recsize) 0.0))
        (setq rec3 (list (+ (car startpt) recsize) (cadr startpt) 0.0))
        (setq rec4 startpt)
        (setq recptlist (list rec1 rec2 rec3 rec4 rec1))

        ;from https://www.afralisp.net/archive/methods/list/addpolyline_method.htm
        (setq ptlist (apply 'append recptlist))
        ;(princ ptlist)
        (if (= (rem (length ptlist) 3) 0)
          (progn
            (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) )
            (vlax-safearray-fill tmp ptlist)
            (setq rec (vla-addPolyline mspace tmp))
          )
          ;(princ "\nerror: Polyline could not be created")
        )
                      
        (setq outputlist (list 0 0 0 0))
        (setq interlist '())
        (setq interlist (LM:intersections plobj rec acextendnone))

        (if (and (<= (car startpt) (car plobjstartpt)) (>= (+ (car startpt) recsize) (car plobjstartpt)))
          (if (and (<= (- (cadr startpt) recsize) (cadr plobjstartpt)) (>= (cadr startpt) (cadr plobjstartpt)))
            (setq interlist (cons plobjstartpt interlist))
          )
        )

        (if (and (<= (car startpt) (car plobjendpt)) (>= (+ (car startpt) recsize) (car plobjendpt)))
          (if (and (<= (- (cadr startpt) recsize) (cadr plobjendpt)) (>= (cadr startpt) (cadr plobjendpt)))
            (setq interlist (cons plobjendpt interlist))
          )
        )

        (setq interlistlen (length interlist))
        (if (> interlistlen 0)
          (progn
            (setq interlistindex 0)
            (repeat interlistlen
              (setq intera (nth interlistindex interlist))
              (setq recdist (list (list 1 (distance rec1 intera)) (list 2 (distance rec2 intera)) (list 3 (distance rec3 intera)) (list 4 (distance rec4 intera)) ))
              (setq recdist (vl-sort recdist (function (lambda (x1 x2)(< (cadr x1) (cadr x2))) ) ))
              (setq recmin (car (car recdist)))
              (cond
                ((= recmin 1) (setq outputlist (list (+ (car outputlist) 1) (cadr outputlist) (caddr outputlist) (cadddr outputlist))))
                ((= recmin 2) (setq outputlist (list (car outputlist) (+ (cadr outputlist) 1) (caddr outputlist) (cadddr outputlist))))
                ((= recmin 3) (setq outputlist (list (car outputlist) (cadr outputlist) (+ (caddr outputlist) 1) (cadddr outputlist))))
                ((= recmin 4) (setq outputlist (list (car outputlist) (cadr outputlist) (caddr outputlist) (+ (cadddr outputlist) 1))))     
              )
              (setq interlistindex (+ interlistindex 1))
            )
          );end of progn
        );end of if
        ;(princ outputlist)  
        (setq outborder (list 0))
        (setq zerocounter 0)
        (if (= (car outputlist) 0) (setq zerocounter (+ zerocounter 1)))
        (if (= (cadr outputlist) 0) (setq zerocounter (+ zerocounter 1)))
        (if (= (caddr outputlist) 0) (setq zerocounter (+ zerocounter 1)))
        (if (= (cadddr outputlist) 0) (setq zerocounter (+ zerocounter 1)))
        (if (= zerocounter 3) (setq outputlist (list 0 0 0 0)))
        (cond
          ((= outputlist (list 1 0 0 1)) (setq outborder (list 1)))
          ((= outputlist (list 2 0 0 2)) (setq outborder (list 1)))
          ((= outputlist (list 3 0 0 1)) (setq outborder (list 1)))
          ((= outputlist (list 2 0 0 1)) (setq outborder (list 1)))
          ((= outputlist (list 1 0 0 3)) (setq outborder (list 1)))
          ((= outputlist (list 1 0 0 2)) (setq outborder (list 1)))
          ((= outputlist (list 0 1 1 0)) (setq outborder (list 2)))
          ((= outputlist (list 0 2 2 0)) (setq outborder (list 2)))
          ((= outputlist (list 0 3 1 0)) (setq outborder (list 2)))
          ((= outputlist (list 0 2 1 0)) (setq outborder (list 2)))
          ((= outputlist (list 0 1 3 0)) (setq outborder (list 2)))
          ((= outputlist (list 0 1 2 0)) (setq outborder (list 2)))
          ((= outputlist (list 0 0 1 1)) (setq outborder (list 3)))
          ((= outputlist (list 0 0 2 2)) (setq outborder (list 3)))
          ((= outputlist (list 0 0 3 1)) (setq outborder (list 3)))
          ((= outputlist (list 0 0 2 1)) (setq outborder (list 3)))
          ((= outputlist (list 0 0 1 3)) (setq outborder (list 3)))
          ((= outputlist (list 0 0 1 2)) (setq outborder (list 3)))
          ((= outputlist (list 1 1 0 0)) (setq outborder (list 4)))
          ((= outputlist (list 2 2 0 0)) (setq outborder (list 4)))
          ((= outputlist (list 1 3 0 0)) (setq outborder (list 4)))
          ((= outputlist (list 1 2 0 0)) (setq outborder (list 4)))
          ((= outputlist (list 3 1 0 0)) (setq outborder (list 4)))
          ((= outputlist (list 2 1 0 0)) (setq outborder (list 4)))
          ((= outputlist (list 0 1 0 1)) (setq outborder (list 5)))
          ((= outputlist (list 0 2 0 2)) (setq outborder (list 5)))
          ((= outputlist (list 0 3 0 1)) (setq outborder (list 5)))
          ((= outputlist (list 0 2 0 1)) (setq outborder (list 5)))
          ((= outputlist (list 0 1 0 3)) (setq outborder (list 5)))
          ((= outputlist (list 0 1 0 2)) (setq outborder (list 5)))
          ((= outputlist (list 1 0 1 0)) (setq outborder (list 6)))
          ((= outputlist (list 2 0 2 0)) (setq outborder (list 6)))
          ((= outputlist (list 3 0 1 0)) (setq outborder (list 6)))
          ((= outputlist (list 2 0 1 0)) (setq outborder (list 6)))
          ((= outputlist (list 1 0 3 0)) (setq outborder (list 6)))
          ((= outputlist (list 1 0 2 0)) (setq outborder (list 6)))

          ((= outputlist (list 0 1 1 2)) (setq outborder (list 3 5)))
          ((= outputlist (list 0 1 2 1)) (setq outborder (list 2 3)))
          ((= outputlist (list 0 2 1 1)) (setq outborder (list 2 5)))
          ((= outputlist (list 1 0 1 2)) (setq outborder (list 1 3)))
          ((= outputlist (list 1 0 2 1)) (setq outborder (list 3 6)))
          ((= outputlist (list 2 0 1 1)) (setq outborder (list 1 6)))
          ((= outputlist (list 2 1 0 1)) (setq outborder (list 1 4)))
          ((= outputlist (list 1 2 0 1)) (setq outborder (list 4 5)))
          ((= outputlist (list 1 1 0 2)) (setq outborder (list 1 5)))
          ((= outputlist (list 2 1 1 0)) (setq outborder (list 4 6)))
          ((= outputlist (list 1 2 1 0)) (setq outborder (list 2 4)))
          ((= outputlist (list 1 1 2 0)) (setq outborder (list 2 6)))

          ((= outputlist (list 0 2 2 2)) (setq outborder (list 2 3 5)))
          ((= outputlist (list 2 0 2 2)) (setq outborder (list 1 3 6)))
          ((= outputlist (list 2 2 0 2)) (setq outborder (list 1 4 5)))
          ((= outputlist (list 2 2 2 0)) (setq outborder (list 2 4 6)))      

          ((= outputlist (list 1 1 2 2)) (setq outborder (list 1 2 3)))
          ((= outputlist (list 2 1 1 2)) (setq outborder (list 1 3 4)))
          ((= outputlist (list 2 2 1 1)) (setq outborder (list 1 2 4)))
          ((= outputlist (list 1 2 2 1)) (setq outborder (list 2 3 4)))

          ((= outputlist (list 0 0 0 0)) (setq outborder (list 0)))
          (t (princ outputlist) (setq outborder (list 0)))
        )
        ;(princ outborder)
        (setq outborderrow (cons outborder outborderrow))
  
        (vla-delete rec)
        (setq startpt (list (+ (car startpt) recsize) (cadr startpt) 0.0))
        (setq xindex (+ xindex 1))
      )
      (setq outbordercolumn (cons (reverse outborderrow) outbordercolumn))
      (setq startpt (list returnx (- (cadr startpt) recsize) 0.0))
      (setq yindex (+ yindex 1))
    )
    (setq outborderstack (cons (list plobjlength (reverse outbordercolumn)) outborderstack))
    (setq startpt (list returnx returny 0.0))

    );end of progn
    );end of if
    (setq plindex (+ plindex 1))
  );end of repeat
  (setq outborderstack (reverse outborderstack))
  outborderstack
)


;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Intersections Between Sets  -  Lee Mac
;; Returns a list of all points of intersection between objects in two selection sets.
;; ss1,ss2 - [sel] Selection sets

(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)




(defun ex:RELEASEEXCEL ( / )
 (if (= AcSheet nil) 
   (progn)
   (progn 
     (vlax-release-object AcSheet)
     ;(princ "\n Acsheet Release for next time. Complete.")
   )
 )
 (if (= Sheets nil)
   (progn)
   (progn 
     (vlax-release-object Sheets)
     ;(princ "\n Sheets Release for next time. Complete.")
   )
 )
 (if (= Workbooks nil)
   (progn)
   (progn 
     (vlax-release-object Workbooks)
     ;(princ "\n Workbooks Release for next time. Complete.")
   )
 )
 (if (= ExcelApp nil)
   (progn)
   (progn 
     (vlax-release-object ExcelApp)
     ;(princ "\n ExcelApp Release for next time. Complete.")   
   )
 )
)

plex1.gif

 

This can only be used in very limited cases.

It was created for express Overall tray route in the Excel report. for my work.

I originally wrote the .wmf image output with a transparent background, 

but my boss wanted the result to fit the cell perfectly.

 

One tray must consist of one polyline line for this Lisp to work. 

if the total length is less than one square, it will not be displayed properly. 

 

plex2.gif

 

The length is the entire length of the polyline, not in the selection range. It is a function that is not necessary for my work, so I wrote it roughly

 

I am looking for a way to find the partial length of a polyline in a closed region. 

I wonder if there is only a way to extract each node, measure the length between the intersection and the inner node, and add them.

 

- How to use 

1. Enter PLEX. 

2. Enter the number of columns you want in excel. 

3. Specify the range.

4. The Excel window opens and displays.

 

- Operation Description 

1. Divide the width of the range to be expressed by the number of entered columns. 

2. Create a square with a value of 1 based on the upper-left endpoint. 

3. Cycle through and select one of the incoming polylines in the entire range, and determine whether it overlaps the square. 

4. In case of overlap, calculate the closest point to the 4 points of the square. 

5. When there are two or more points that are close within one cell, the border connecting the points is determined. 

6. Express in Excel.

 

 

The calculation time is not determined by the actual length of the polyline, 

by the number of polylines and the number of entered columns. 

The larger the number of columns, the more detailed it is, but it becomes slower.

Edited by exceed
add more case2
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.

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