+ Reply to Thread
Page 3 of 3 FirstFirst 1 2 3
Results 21 to 23 of 23
  1. #21
    Senior Member
    Using
    AutoCAD 2008
    Join Date
    Aug 2007
    Posts
    115

    Default

    Registered forum members do not see this ad.

    What i'm trying to do is to create is a single pline to repersent a duct work with sizes that later after you have laid out HVAC mechanical duct then label them buy just selecting and asked where to place the text with the info extracted form the pline.
    I have a lisp tool that extracts atribute info, but it would save time if I was to just select the pline and select where I want the pline info placed.
    Commands used: Pline lines and arc’s.

  2. #22
    Forum Newbie
    Discipline
    Electrical
    lamngo17's Discipline Details
    Occupation
    Electrical designer - Power
    Discipline
    Electrical
    Using
    AutoCAD 2010
    Join Date
    May 2013
    Location
    Washington State
    Posts
    1

    Default Software

    Quote Originally Posted by ASMI View Post
    <-- Please read post before.
    Code:
    (defun c:dwrite(/ plObj stBl enBl datLst cAns hyObj okFlg cMat mLst mNum)
     
    ; ************ MODIFY LIST OF MATERIALS ************
     
      (setq mLst '(
               (0 . "N/A")
               (1 . "DIN 2391")
               (2 . "DIN 2392")
               (3 . "DIN 2394")
               )
        ); end setq
     
     
    ; ************ MODIFY DEFAULT MATERIAL ************
     
      (if(not dwrite:material)
         (setq dwrite:material "N/A")
        ); end if
     
     
     
      (defun Entsel_or_Text(Spaces Message / lChr tStr grLst filPt
                selSet outVal pSps)
      (princ Message)
      (setq tStr ""); end setq
      (if Spaces
        (setq pSps(list "\r"))
        (setq pSps(list " " "\r"))
        ); end if
       (while
          (and
            (not(member lChr pSps))
        (/= 3(car grLst))
            ); end and
          (if
            (setq grLst(grread nil 4 2))
            (progn
             (cond
              ((= 3(car grLst))
               (setq filPt(cadr grLst)
                     selSet(ssget filPt)
                     ); end setq
               (if selSet
                    (setq outVal
                    (list(ssname selSet 0)filPt))
                 ); end if
               ); end condition #1
          ((or
             (equal '(2 13) grLst)
             (equal 25(car grLst))
             ); end or
            (setq lChr "\r"
              outVal tStr); end setq
           ); end condition #2
          ((and
             (equal '(2 8) grLst)
             (< 0(strlen tStr))
             ); end and
           (setq tStr(substr tStr 1(1-(strlen tStr))))
           (princ(strcat(chr 8)(chr 32)(chr 8)))
           ); end condition #3
              ((and
             (= 2(car grLst))
             (<= 32(cadr grLst)126)
             ); end and
               (setq lChr(chr(cadr grLst)))
               (if(not(member lChr pSps))
                     (progn
                     (setq tStr(strcat tStr lChr)
                           outVal tStr); end setq
                 (princ lChr)
               ); end progn
              ); end if
             ); end condition #4
            ); end cond
           ); end progn
          ); end if
         ); end while
        outVal
     ); end of Entsel_or_Text
     
     
      (while(not okFlg)
        (princ(strcat "\nCurrent material = " dwrite:material))
        (setq plObj(Entsel_or_Text T "\nSelect polyline or [Material]: "))
        (cond
          ((and
          (= 'LIST(type plObj))
          (= "LWPOLYLINE"(cdr(assoc 0(entget(car plObj)))))
         ); end and
           (setq plObj(car plObj)
             okFlg T); end setq
           ); end condition #1
          ((= 'LIST(type plObj))
           (princ "\nThis isn't LwPolyline! ")
           ); end condition #2
          ((and
         (= 'STR(type plObj))
         (member(strcase plObj) '("M" "_M" "MATERIAL" "_MATERIAL"))
     
         ); end and
           (textscr)
           (princ "\n====== MATERIAL LIST ======")
           (foreach m mLst
         (princ(strcat "\n[" (itoa(car m)) "] - "(cdr m)))
         ); end foreach
           (princ "\n===========================")
           (setq mNum(getint "\nSelect material from list: "))
           (if(and mNum(setq cMat(assoc mNum mLst)))
         (progn
           (setq dwrite:material(cdr cMat))
           (graphscr)
           ); end progn
         (princ "\nCan't find material with this number! ")
         ); end if
           ); end condition #3
          ((null plObj)
            (princ "\nEmpty selection! ")
           ); end condition #4
          (T
           (princ "\nInvalid keyword option! ")
           ); end condition #5
          ); end cond
        ); end while
      (while(not stBl)
        (setq stBl(Entsel_or_Text T "\nSelect 'Begin' block or type name: "))
        (cond
          ((and
         (= 'LIST(type stBl))
         (= "INSERT"(cdr(assoc 0(entget(car stBl)))))
        ); end and
            (setq stBl(cdr(assoc 2(entget(car stBl)))))
           ); end condition #1
          ((= 'LIST(type stBl))
            (princ "\nThis isn't block! ")
            (setq stBl nil)
           ); end condition #2
          ((null stBl)
           (princ "\nEmpty input! ")
           ); end condition #3
          ); end cond
        ); end while
     (while(not enBl)
        (setq enBl(Entsel_or_Text T "\nSelect 'End' block or type name: "))
        (cond
          ((and
         (= 'LIST(type enBl))
         (= "INSERT"(cdr(assoc 0(entget(car enBl)))))
        ); end and
            (setq enBl(cdr(assoc 2(entget(car enBl)))))
           ); end condition #1
          ((= 'LIST(type enBl))
            (princ "\nThis isn't block! ")
            (setq enBl nil)
           ); end condition #2
          ((null enBl)
           (princ "\nEmpty input! ")
           ); end condition #3
          ); end cond
        ); end while
      (setq datLst(list(cons 1 stBl)(cons 2 enBl)(cons 3 dwrite:material))
        plObj(vlax-ename->vla-object plObj)
        hyObj(vla-get-Hyperlinks plObj)
        ); end setq
      (if(vlax-ldata-get plObj "PipeData")
          (progn
        (initget "Yes No")
        (setq cAns(getkword "\nPipe data already exists. Overwrite? [Yes/No]<Yes>: "))
        (if(null cAns)(setq cAns "Yes"))
        (if(= "Yes" cAns)
          (progn
           (vlax-ldata-delete plObj "PipeData")
           (vlax-ldata-put plObj "PipeData" datLst)
           (vla-Delete(vla-Item hyObj 0))
           (vla-Add hyObj "Has Pipe Data" (strcat "ID: "  (itoa(vla-get-ObjectID plObj))
                                  "\nMaterial: " dwrite:material
                                  "\nLength: " (rtos(vlax-curve-GetDistAtParam plObj
                                                   (vlax-curve-GetEndParam plObj)))))
           (princ "\n<<< Data successfuly added >>> ")
           ); end progn
          ); end if
        ); end progn
          (progn
           (vlax-ldata-put plObj "PipeData" datLst)
           (vla-Add hyObj "Has Pipe Data" (strcat "ID: "  (itoa(vla-get-ObjectID plObj))
                              "\nMaterial: " dwrite:material
                              "\nLength: " (rtos(vlax-curve-GetDistAtParam plObj
                                               (vlax-curve-GetEndParam plObj)))))
           (princ "\n<<< Data successfuly added >>> ")
           ); end progn
          ); end if    
      (princ)
     ); c:dwrite
     
     
     
     
    (defun c:dcollect(/ plSet oLst cDat fDescr fName cAns exApp wbCol cDoc)
      (if(setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
        (progn
          (foreach pl (mapcar 'vlax-ename->vla-object
                         (vl-remove-if 'listp
                           (mapcar 'cadr(ssnamex plSet))))
        (if(setq cDat(vlax-ldata-get pl "PipeData"))
          (progn
            (setq oLst(cons
                (list
                     (vla-get-ObjectID pl)
                     (vla-get-ConstantWidth pl)
                     (vla-get-Layer pl)
                     (cdr(assoc 1 cDat))
                     (cdr(assoc 2 cDat))
                     (cdr(assoc 3 cDat))
                     (vlax-curve-GetDistAtParam pl
                       (vlax-curve-GetEndParam pl))
                    ); end list
                  oLst); end cons
              ); end setq
            ); end progn
          ); end if
        ); end foreach
          (if oLst
        (progn
          (setq fDescr(open
                (setq fName(strcat(vl-filename-directory(getvar "SAVENAME"))
                  "\\"(vl-filename-base(getvar "DWGNAME")) ".csv")) "w"))
          (write-line "Pipe ID;Diameter;Layer;From;To;Material;Length" fDescr)
          (foreach itm (reverse oLst)
                  (write-line(strcat (itoa(nth 0 itm))
                     ";" (strcat(rtos(* 1000.0(nth 1 itm)))
                     ";" (nth 2 itm)
                     ";" (nth 3 itm)
                     ";" (nth 4 itm)
                     ";" (nth 5 itm)
                     ";" (rtos(nth 6 itm)))
                  ); end strcat
            fDescr)
            ); end foreach
          (close fDescr)
          (princ(strcat "\nCSV file location: " fName ))
          (initget "Yes No")
          (setq cAns(getkword "\nOpen file [Yes/No]: "))
          (if(= cAns "Yes")
            (if(setq exApp(vlax-get-or-create-object "Excel.Application"))
              (progn
            (vlax-put-property exApp 'Visible :vlax-true)
                (setq wbCol(vlax-get-property exApp 'Workbooks)
                  cDoc(vlax-invoke-method wbCol 'Open fName))
            (vlax-release-object cDoc)
            (vlax-release-object wbCol)
            (vlax-release-object exApp)
            ); end progn
              ); end if
            ); end if
          ); end progn
        (princ "\nNo data found! ")
        ); end if
          ); end progn
        ); end if
      (princ)
      ); end of c:dcollect
     
     
     
    (defun c:ddata(/ cEnt cDat cPln)
      (if(setq cEnt(entsel "\nSelect polyline to view data: "))
        (if(= "LWPOLYLINE"(cdr(assoc 0(entget(car cEnt)))))
          (if(setq cDat(vlax-ldata-get(setq cPln(vlax-ename->vla-object(car cEnt))) "PipeData"))
        (alert(strcat
            "                   PIPE DATA                 \n"
            "\nPipe ID: " (itoa(vla-get-ObjectID cPln))
            "\nDiameter: " (rtos(* 1000.0(vla-get-ConstantWidth cPln)2 0))
            "\nLayer: " (vla-get-Layer cPln)
            "\nFrom: " (cdr(assoc 1 cDat))
            "\nTo: " (cdr(assoc 2 cDat))
            "\nMaterial: " (cdr(assoc 3 cDat))
            "\nLength: " (rtos(vlax-curve-GetDistAtParam cPln
                           (vlax-curve-GetEndParam cPln)))
            ); end strcat
              ); end alert
        (princ "\nNo data found! ")
        ); end if
          (princ "\nThis isn't LwPolyline! ")
          ); end if
        (princ "\nNothing selected! ")
        ); end if
      (princ)
      ); end of c:ddata
     
     
     
    (defun c:ddelete(/ cCnt cAns plSet cDat hyCol cHyp)
      (initget 1 "All Selection")
      (setq cAns(getkword "\nWhich data to delete [All/Selection]: ")
        cCnt 0)
      (if(= cAns "All")
        (setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
        (setq plSet(ssget '((0 . "LWPOLYLINE"))))
        ); end if
      (getstring "\n*** WARNING! All data will deleted. Enter to Continue or Esc to Quite. ***")
      (if plSet
        (progn
          (foreach pl (mapcar 'vlax-ename->vla-object
                         (vl-remove-if 'listp
                           (mapcar 'cadr(ssnamex plSet))))
        (if(setq cDat(vlax-ldata-get pl "PipeData"))
          (progn
            (vlax-ldata-delete pl "PipeData")
            (setq cCnt(1+ cCnt))
            ); end progn
          ); end if
                (vlax-for hy(vla-get-Hyperlinks pl)
              (if(= "Has Pipe Data"(vla-get-URL hy))
            (vla-Delete hy)
            ); end vlax-for
              ); end vlax-for
        ); end foreach
          (if(/= 0 cCnt)
        (princ(strcat "\n<<< " (itoa cCnt) " item(s) was deleted >>> "))
        (princ "\nNothing data found! ")
        ); end if
          ); end progn
        ); end if
      (princ)
      ); end of c:ddelete
     
    (vl-load-com)
    DWRITE - write data
    DCOLLECT - put data to *.csv file
    DDATA - view data
    DDELETE - remove all or selected data
    ASMI, what program can I use to write this code? I am trying to write a command for AutoCAD where it would read the attribute of the block within a polyline and extract the data to excel file. Please help. Thank you!

  3. #23
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Pietari, Venäjä
    Posts
    1,687

    Default

    Registered forum members do not see this ad.

    Upload a drawing with this polyline(s)
    and screenshot of Excel file to make more sence,
    may be I can help
    I guess ASMI is out of this forum now
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

Similar Threads

  1. Extracting Object Data, convert to text
    By jerrodt in forum Autodesk Software General
    Replies: 2
    Last Post: 20th Jun 2012, 09:07 am
  2. Extracting Data from Blocks for Parts List
    By ziemerd in forum AutoCAD Drawing Management & Output
    Replies: 15
    Last Post: 17th Nov 2008, 11:32 pm
  3. extracting spline data
    By motee-z in forum AutoLISP, Visual LISP & DCL
    Replies: 7
    Last Post: 21st May 2006, 11:57 am
  4. Extracting Data
    By LSR in forum AutoLISP, Visual LISP & DCL
    Replies: 12
    Last Post: 15th Jun 2005, 08:41 pm
  5. Extracting attribute data
    By j_r_auden in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 3rd Feb 2005, 09:23 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts