CADsite forum

Aan allen,

Onderaan staat een routine weergegeven welke het mogelijk maakt om, in excel, een opsomming weer te geven van de lijnvormige elementen in een tekening. Superhandige tool, zo heb ik de indruk.

De routine werkt perfect, enkel dienen nog wat ruwe kantjes afgevijlt te worden.

Hierbij twee vragen:

vraag 1 :
Handig ware om in excel de tekst  "SubTotal" in de tweede kolom weer te geven en de kolom met length te verschuiven naar de derde kolom.
Dat is enkel om eenvoudiger de data alfabetisch te sorteren.
Is dit mogelijk?

vraag 2:
Is er een mogelijkheid om in een tweede tabblad een totaal te maken van oppervlaktes van hatches.
Dit graag per layer en per vierkante meter.

dat zou super zijn.

Groeten en dank.
Bart

---



(defun c:ple (/   elist    en     i      layer    layer_list
      leng    pline     row      ss       sumlen   total
      x    xlApp     xlBook   xlBooks  xlCells  xlSheet
      xlSheets
          )
  (vl-load-com)
  (setq   xlApp      (vlax-get-or-create-object "Excel.Application")
   xlBooks  (vlax-get-property xlApp "Workbooks")
   xlBook      (vlax-invoke-method xlBooks "Add")
   xlSheets (vlax-get-property xlBook "Sheets")
   xlSheet      (vlax-get-property xlSheets "Item" 1)
   xlCells      (vlax-get-property xlSheet "Cells")
  )
  (vla-put-visible xlApp :vlax-true)
  ;headers
  (vlax-put-property xlCells "Item" 1 1 "Layer")
  (vlax-put-property xlCells "Item" 1 2 "Length")
 
  (setq row 2
   total 0)

  (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)
  (repeat (sslength ss)
    (setq en (ssname ss (setq i (1+ i)))
     elist (entget en)
     layer (cdr (assoc 8 elist)))
    (if (not (member layer layer_list))
      (setq layer_list (cons layer layer_list))))
 
 
  (repeat (length layer_list)
    (setq layer (car layer_list))
    (vlax-put-property xlCells "Item" row 1 layer)
    (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    (repeat (sslength ss)
    (setq row (1+ row)) 
    (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
    (setq leng  (vlax-curve-getdistatparam pline
        (vlax-curve-getendparam pline)))
    (vlax-put-property xlCells "Item" row 2 (rtos leng 4 3))
        (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3)); for metric units 
    (setq sumlen (+ sumlen leng)))
    (setq row (1+ row))
    (vlax-put-property xlCells "Item" row 1 "SubTotal:")
    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 4 3))
    (setq total (+ total sumlen))
    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units
    (setq layer_list (cdr layer_list))
    (setq row (+ row 2))
   
  )

; footers:
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 4 3))
(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units 

(mapcar (function (lambda(x)
          (vl-catch-all-apply
            (function (lambda()
              (progn
                (vlax-release-object x)
                (setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(alert "Close Excel file manually")
(gc)(gc)
(princ)
  )
(princ "\t\t***\t  Type PLE to write polines length to Excel\t***")
(princ)

Hoi Bart,
Ik weet niet of dit nog nodig is maar je kunt eventueel hulp vragen via deze site.

http://www.jefferypsanders.com/autolisp.html#AXcel

Mocht je dit doen dan zou ik het leuk vinden als je hun antwoord ook aan mij doorgeeft.

Ik heb namelijk ook interesse in deze LISP. 

Met vriendelijke groet,
Adrianus.

"For the time being" kun je wellicht gebruik maken van het programma wat je kunt downloaden via onderstaande link.

http://www.glamsen.se/CadTools.htm

Groet,
Adrianus.

Adrianus,

Ik laat het zeker weten.

Groeten,
Bart