Results 1 to 7 of 7

Thread: Arc Data lisp works only with Arc entities, not curved polyline segments.

  1. #1
    I could stop if I wanted to jpcadconsulting347236's Avatar
    Join Date
    2011-09
    Posts
    258
    Login to Give a bone
    0

    Default Arc Data lisp works only with Arc entities, not curved polyline segments.

    Hiya gang,

    I've cobbled together this code (with lots of help from, probably, Lee mac, Tharwat...) that allows my staff to select and arc and insert a block pre-populated with data extracted from the selected arc.

    Works great... but it only works when selecting arcs. Selecting a curved segment of a polyline crashes it.

    So, I'd love some advice to do two things:


    1. Allow it to work with curved polyline segments
    2. Modify it to use fields so that when the arc or polyline is modified, the data updates


    Thanks as always!!!

    -JP


    Code:
    (defun c:CurveTag (/ ent obj CL SCL CID SP EP RAD AL)
    
    (setvar 'ATTDIA 0)
    
    
    (setq CL (getvar "CLAYER"))
    
    
    ;;;;; Collect units information and set scale
    (cond ((= (getvar "INSUNITS") 1) (setq SCL 1))
          ((= (getvar "INSUNITS") 2) (setq SCL 0.08333))
          ((= (getvar "INSUNITS") 4) (setq SCL 25.4))
          ((= (getvar "INSUNITS") 5) (setq SCL 2.54))
          ((= (getvar "INSUNITS") 6) (setq SCL 0.0254))
          (t (alert "Current DWG set to non-standard units.  Check UNITS settings"))
    )
    
    
    
    
    
    
    ;;;;; Collect arc data
    
    
    (if (setq ent (car (entsel "\nSelect arc: ")))
    (progn
    (setq obj (vlax-ename->vla-object ent)
    AL (strcat (rtos (vlax-get obj 'arclength) 4 3))
    RAD (strcat (rtos (vlax-get obj 'radius) 4 3))
    SP (strcat (rtos (car (vlax-get obj 'Startpoint)) 4 3) ", " (rtos (cadr (vlax-get obj 'Startpoint)) 4 3))
    EP (strcat (rtos (car (vlax-get obj 'Endpoint)) 4 3) ", " (rtos (cadr (vlax-get obj 'Endpoint)) 4 3))
    )
    )
    )
    
    
    (setq CID (getstring "\nEnter Curve ID: "))
    
    
    
    
    ;;;;; Bring in block "MNLA Curve Tag r00" from Callouts.dwg
    
    
    (defun open_dbx (dwg / dbx)
       (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
          (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
          (setq dbx (vlax-create-object
          (strcat "ObjectDBX.AxDbDocument."
             (substr (getvar "ACADVER") 1 2)
             )
          )
       )
    )
    (vla-open dbx dwg)
    dbx
    )
    (setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
    (vla-CopyObjects
    Dbx
    (vlax-safearray-fill
    (vlax-make-safearray vlax-vbObject '(0 . 0))
    (list (vla-item (vla-get-blocks dbx) "MNLA Curve Tag r00"))
    )
    (vla-get-blocks
    (vla-get-activedocument (vlax-get-acad-object))
    )
    )
    (vlax-release-object dbx)
    
    
    
    
    
    
    ;;;;; Insert and populate block
    
    
    (command "-layer" "Make" "L-ANNO-SYMB" "Color" "3" "L-ANNO-SYMB" "Ltype" "CONTINUOUS" "" "Plot" "P" "" "")
    (setvar "CLAYER" "L-ANNO-SYMB")
    
    
    
    
    (setq p (getpoint "\n Specify point :"))
    
    
      (command "_.-insert"
    
    
               "MNLA Curve Tag r00"
               "Scale"
               SCL
               "_none"
    
    
               p
    
    
               ""
    
    
               CID
               AL
               RAD
               SP
               EP
    )
    
    
    (setvar "CLAYER" CL)
    
    
    (princ)
    )
    James Pertusi

    CAD Applications Consultant
    1 (646) 773 4834
    www.jpcadconsulting.com

  2. #2
    All AUGI, all the time Tharwat's Avatar
    Join Date
    2010-06
    Posts
    874
    Login to Give a bone
    0

    Default Re: Arc Data lisp works only with Arc entities, not curved polyline segments.

    Hi,

    Please try the following untested codes and let me know how it works.
    Code:
    (defun c:CurveTag (/      *error*       LM:Bulge->Arc ent    obj
                       SCL    CID    SP     EP     RAD    dbx    p
                       utl    lst    doc    dxf    prt    sel    unit
                       start  end
                      )
      (defun *error* (x)
        (if lst
          (mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
        )
        (princ)
      )
      (defun LM:Bulge->Arc (p1 p2 b / c r)
        ;; Bulge to Arc  -  Lee Mac
        (setq r (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
              c (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) r)
        )
        (if (minusp b)
          (list c (angle c p2) (angle c p1) (abs r))
          (list c (angle c p1) (angle c p2) (abs r))
        )
      )
    ;;;;; Collect units information and set scale
      (cond
        ((= (setq unit (getvar "INSUNITS")) 1) (setq SCL 1))
        ((= unit 2) (setq SCL 0.08333))
        ((= unit 4) (setq SCL 25.4))
        ((= unit 5) (setq SCL 2.54))
        ((= unit 6) (setq SCL 0.0254))
        (t
         (setq unit nil)
         (alert
           "Current DWG set to non-standard units. Check UNITS settings"
         )
        )
      )
    ;;;;; Collect arc data
      (princ
        "\nSelect arcs and LWpolyline with one arc segment as an arc :"
      )
      (if (and unit
               (setq sel (ssget "_+.:S:E"
                                '((-4 . "<OR")
                                  (-4 . "<AND")
                                  (0 . "LWPOLYLINE")
                                  (90 . 2)
                                  (-4 . "<NOT")
                                  (42 . 0.0)
                                  (-4 . "NOT>")
                                  (-4 . "AND>")
                                  (0 . "ARC")
                                  (-4 . "OR>")
                                 )
                         )
               )
               (/= (setq CID (getstring "\nEnter Curve ID: ")) "")
               (setq dxf (entget (ssname sel 0)))
          )
        (progn
          (setq obj (vlax-ename->vla-object (ssname sel 0)))
          (if (= (vla-get-objectname obj) "AcDbArc")
            (setq prt "ArcLength"
                  rad (rtos (vlax-get obj 'radius) 4 3)
            )
            (setq prt "Length"
                  rad (last (LM:Bulge->Arc
                              (cdr (assoc 10 dxf))
                              (cdr (assoc 10 (reverse dxf)))
                              (cdr (assoc 42 dxf))
                            )
                      )
            )
          )
          (setq lst   (mapcar 'getvar '(ATTDIA ATTREQ CLAYER))
                start (vlax-get obj 'Startpoint)
                end   (vlax-get obj 'Endpoint)
                SP    (strcat (rtos (car start) 4 3) ", " (rtos (cadr start) 4 3))
                EP    (strcat (rtos (car end) 4 3) ", " (rtos (cadr end) 4 3))
                doc   (vla-get-ActiveDocument (vlax-get-acad-object))
          )
        )
      )
    ;;;;; Bring in block "MNLA Curve Tag r00" from Callouts.dwg
      (defun open_dbx (dwg / dbx)
        (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
          (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
          (setq dbx (vlax-create-object
                      (strcat "ObjectDBX.AxDbDocument."
                              (substr (getvar "ACADVER") 1 2)
                      )
                    )
          )
        )
        (vla-open dbx dwg)
        dbx
      )
      ;;				;;
      (setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
      (vla-CopyObjects
        Dbx
        (vlax-safearray-fill
          (vlax-make-safearray vlax-vbObject '(0 . 0))
          (list (vla-item (vla-get-blocks dbx) "MNLA Curve Tag r00"))
        )
        (vla-get-blocks doc)
      )
      (vlax-release-object dbx)
    ;;;;; Insert and populate block
      (command "-layer"    "Make"      "L-ANNO-SYMB"           "Color"
               "3"         "L-ANNO-SYMB"           "Ltype"     "CONTINUOUS"
               ""          "Plot"      "P"         ""          ""
              )
      (if
        (and (or (tblsearch "BLOCK" "MNLA Curve Tag r00")
                 (alert
                   "Block name < MNLA Curve Tag r00 > is not yet existed."
                 )
             )
             (setq p (getpoint "\n Specify point :"))
             (mapcar 'setvar '(ATTDIA ATTREQ) '(0 0))
        )
         (command "_.-insert"
                  "MNLA Curve Tag r00"
                  "Scale"
                  SCL
                  "_none"
                  p
                  ""
                  CID
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                          (if (vlax-method-applicable-p
                                (setq utl (vla-get-Utility doc))
                                'GetObjectIdString
                              )
                            (vla-GetObjectIdString utl obj :vlax-false)
                            (itoa (vla-get-ObjectId obj))
                          )
                          ">%)."
                          prt
                          ">%"
                  )
                  RAD
                  SP
                  EP
         )
      )
      (mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
      (princ)
    )

  3. #3
    I could stop if I wanted to jpcadconsulting347236's Avatar
    Join Date
    2011-09
    Posts
    258
    Login to Give a bone
    0

    Default Re: Arc Data lisp works only with Arc entities, not curved polyline segments.

    Thanks Tharwat! I was away for a bit during the holidays but I'm going to test now.

    Happy new year and thanks for all your help in the past!!

    -JP
    James Pertusi

    CAD Applications Consultant
    1 (646) 773 4834
    www.jpcadconsulting.com

  4. #4
    I could stop if I wanted to jpcadconsulting347236's Avatar
    Join Date
    2011-09
    Posts
    258
    Login to Give a bone
    0

    Default Re: Arc Data lisp works only with Arc entities, not curved polyline segments.

    Eh... well no luck.

    I think it has to do with the code in red which is replacing the SETQ for "AL" in the original code:

    Code:
    ;;;;; Collect arc data
    
    (if (setq ent (car (entsel "\nSelect arc: ")))
    (progn
    (setq obj (vlax-ename->vla-object ent)
    AL (strcat (rtos (vlax-get obj 'arclength) 4 3))
    RAD (strcat (rtos (vlax-get obj 'radius) 4 3))
    SP (strcat (rtos (car (vlax-get obj 'Startpoint)) 4 3) ", " (rtos (cadr (vlax-get obj 'Startpoint)) 4 3))
    EP (strcat (rtos (car (vlax-get obj 'Endpoint)) 4 3) ", " (rtos (cadr (vlax-get obj 'Endpoint)) 4 3))
    )
    )
    )
    
    (setq CID (getstring "\nEnter Curve ID: "))



    Code:
    (defun c:CurveTagTEST (/      *error*       LM:Bulge->Arc ent    obj
                       SCL    CID    SP     EP     RAD    dbx    p
                       utl    lst    doc    dxf    prt    sel    unit
                       start  end
                      )
      (defun *error* (x)
        (if lst
          (mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
        )
        (princ)
      )
      (defun LM:Bulge->Arc (p1 p2 b / c r)
        ;; Bulge to Arc  -  Lee Mac
        (setq r (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
              c (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) r)
        )
        (if (minusp b)
          (list c (angle c p2) (angle c p1) (abs r))
          (list c (angle c p1) (angle c p2) (abs r))
        )
      )
    ;;;;; Collect units information and set scale
      (cond
        ((= (setq unit (getvar "INSUNITS")) 1) (setq SCL 1))
        ((= unit 2) (setq SCL 0.08333))
        ((= unit 4) (setq SCL 25.4))
        ((= unit 5) (setq SCL 2.54))
        ((= unit 6) (setq SCL 0.0254))
        (t
         (setq unit nil)
         (alert
           "Current DWG set to non-standard units. Check UNITS settings"
         )
        )
      )
    ;;;;; Collect arc data
      (princ
        "\nSelect arcs and LWpolyline with one arc segment as an arc :"
      )
      (if (and unit
               (setq sel (ssget "_+.:S:E"
                                '((-4 . "<OR")
                                  (-4 . "<AND")
                                  (0 . "LWPOLYLINE")
                                  (90 . 2)
                                  (-4 . "<NOT")
                                  (42 . 0.0)
                                  (-4 . "NOT>")
                                  (-4 . "AND>")
                                  (0 . "ARC")
                                  (-4 . "OR>")
                                 )
                         )
               )
               (/= (setq CID (getstring "\nEnter Curve ID: ")) "")
               (setq dxf (entget (ssname sel 0)))
          )
        (progn
          (setq obj (vlax-ename->vla-object (ssname sel 0)))
          (if (= (vla-get-objectname obj) "AcDbArc")
            (setq prt "ArcLength"
                  rad (rtos (vlax-get obj 'radius) 4 3)
            )
            (setq prt "Length"
                  rad (last (LM:Bulge->Arc
                              (cdr (assoc 10 dxf))
                              (cdr (assoc 10 (reverse dxf)))
                              (cdr (assoc 42 dxf))
                            )
                      )
            )
          )
          (setq lst   (mapcar 'getvar '(ATTDIA ATTREQ CLAYER))
                start (vlax-get obj 'Startpoint)
                end   (vlax-get obj 'Endpoint)
                SP    (strcat (rtos (car start) 4 3) ", " (rtos (cadr start) 4 3))
                EP    (strcat (rtos (car end) 4 3) ", " (rtos (cadr end) 4 3))
                doc   (vla-get-ActiveDocument (vlax-get-acad-object))
          )
        )
      )
    ;;;;; Bring in block "MNLA Curve Tag r00" from Callouts.dwg
      (defun open_dbx (dwg / dbx)
        (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
          (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
          (setq dbx (vlax-create-object
                      (strcat "ObjectDBX.AxDbDocument."
                              (substr (getvar "ACADVER") 1 2)
                      )
                    )
          )
        )
        (vla-open dbx dwg)
        dbx
      )
      ;;				;;
      (setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
      (vla-CopyObjects
        Dbx
        (vlax-safearray-fill
          (vlax-make-safearray vlax-vbObject '(0 . 0))
          (list (vla-item (vla-get-blocks dbx) "MNLA Curve Tag r00"))
        )
        (vla-get-blocks doc)
      )
      (vlax-release-object dbx)
    ;;;;; Insert and populate block
      (command "-layer"    "Make"      "L-ANNO-SYMB"           "Color"
               "3"         "L-ANNO-SYMB"           "Ltype"     "CONTINUOUS"
               ""          "Plot"      "P"         ""          ""
              )
      (if
        (and (or (tblsearch "BLOCK" "MNLA Curve Tag r00")
                 (alert
                   "Block name < MNLA Curve Tag r00 > is not yet existed."
                 )
             )
             (setq p (getpoint "\n Specify point :"))
             (mapcar 'setvar '(ATTDIA ATTREQ) '(0 0))
        )
         (command "_.-insert"
                  "MNLA Curve Tag r00"
                  "Scale"
                  SCL
                  "_none"
                  p
                  ""
                  CID
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                          (if (vlax-method-applicable-p
                                (setq utl (vla-get-Utility doc))
                                'GetObjectIdString
                              )
                            (vla-GetObjectIdString utl obj :vlax-false)
                            (itoa (vla-get-ObjectId obj))
                          )
                          ">%)."
                          prt
                          ">%"
                  )
                  RAD
                  SP
                  EP
         )
      )
      (mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
      (princ)
    )
    James Pertusi

    CAD Applications Consultant
    1 (646) 773 4834
    www.jpcadconsulting.com

  5. #5
    I could stop if I wanted to jpcadconsulting347236's Avatar
    Join Date
    2011-09
    Posts
    258
    Login to Give a bone
    0

    Default Re: Arc Data lisp works only with Arc entities, not curved polyline segments.

    I've made some progress. I have your code working with plain arcs. The issue was in the ATTREQ setting (in red below):

    However, on splined polylines it does not work (command just exits) and on arc segments within polylines it returns:

    "Select arcs and LWpolyline with one arc segment as an arc :" and then exits.

    Getting there!!!



    Code:
    (defun c:CurveTagTEST (/      *error*       LM:Bulge->Arc ent    obj
                       SCL    CID    SP     EP     RAD    dbx    p
                       utl    lst    doc    dxf    prt    sel    unit
                       start  end
                      )
      (defun *error* (x)
        (if lst
          (mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
        )
        (princ)
      )
      (defun LM:Bulge->Arc (p1 p2 b / c r)
        ;; Bulge to Arc  -  Lee Mac
        (setq r (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
              c (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) r)
        )
        (if (minusp b)
          (list c (angle c p2) (angle c p1) (abs r))
          (list c (angle c p1) (angle c p2) (abs r))
        )
      )
    ;;;;; Collect units information and set scale
      (cond
        ((= (setq unit (getvar "INSUNITS")) 1) (setq SCL 1))
        ((= unit 2) (setq SCL 0.08333))
        ((= unit 4) (setq SCL 25.4))
        ((= unit 5) (setq SCL 2.54))
        ((= unit 6) (setq SCL 0.0254))
        (t
         (setq unit nil)
         (alert
           "Current DWG set to non-standard units. Check UNITS settings"
         )
        )
      )
    ;;;;; Collect arc data
      (princ
        "\nSelect arcs and LWpolyline with one arc segment as an arc :"
      )
      (if (and unit
               (setq sel (ssget "_+.:S:E"
                                '((-4 . "<OR")
                                  (-4 . "<AND")
                                  (0 . "LWPOLYLINE")
                                  (90 . 2)
                                  (-4 . "<NOT")
                                  (42 . 0.0)
                                  (-4 . "NOT>")
                                  (-4 . "AND>")
                                  (0 . "ARC")
                                  (-4 . "OR>")
                                 )
                         )
               )
               (/= (setq CID (getstring "\nEnter Curve ID: ")) "")
               (setq dxf (entget (ssname sel 0)))
          )
        (progn
          (setq obj (vlax-ename->vla-object (ssname sel 0)))
          (if (= (vla-get-objectname obj) "AcDbArc")
            (setq prt "ArcLength"
                  rad (rtos (vlax-get obj 'radius) 4 3)
            )
            (setq prt "Length"
                  rad (last (LM:Bulge->Arc
                              (cdr (assoc 10 dxf))
                              (cdr (assoc 10 (reverse dxf)))
                              (cdr (assoc 42 dxf))
                            )
                      )
            )
          )
          (setq lst   (mapcar 'getvar '(ATTDIA ATTREQ CLAYER))
                start (vlax-get obj 'Startpoint)
                end   (vlax-get obj 'Endpoint)
                SP    (strcat (rtos (car start) 4 3) ", " (rtos (cadr start) 4 3))
                EP    (strcat (rtos (car end) 4 3) ", " (rtos (cadr end) 4 3))
                doc   (vla-get-ActiveDocument (vlax-get-acad-object))
          )
        )
      )
    ;;;;; Bring in block "MNLA Curve Tag r00" from Callouts.dwg
      (defun open_dbx (dwg / dbx)
        (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
          (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
          (setq dbx (vlax-create-object
                      (strcat "ObjectDBX.AxDbDocument."
                              (substr (getvar "ACADVER") 1 2)
                      )
                    )
          )
        )
        (vla-open dbx dwg)
        dbx
      )
      ;;				;;
      (setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
      (vla-CopyObjects
        Dbx
        (vlax-safearray-fill
          (vlax-make-safearray vlax-vbObject '(0 . 0))
          (list (vla-item (vla-get-blocks dbx) "MNLA Curve Tag r00"))
        )
        (vla-get-blocks doc)
      )
      (vlax-release-object dbx)
    ;;;;; Insert and populate block
      (command "-layer"    "Make"      "L-ANNO-SYMB"           "Color"
               "3"         "L-ANNO-SYMB"           "Ltype"     "CONTINUOUS"
               ""          "Plot"      "P"         ""          ""
              )
      (if
        (and (or (tblsearch "BLOCK" "MNLA Curve Tag r00")
                 (alert
                   "Block name < MNLA Curve Tag r00 > is not yet existed."
                 )
             )
             (setq p (getpoint "\n Specify point :"))
             (mapcar 'setvar '(ATTDIA ATTREQ) '(0 1))
        )
         (command "_.-insert"
                  "MNLA Curve Tag r00"
                  "Scale"
                  SCL
                  "_none"
                  p
                  "0"
                  CID
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                          (if (vlax-method-applicable-p
                                (setq utl (vla-get-Utility doc))
                                'GetObjectIdString
                              )
                            (vla-GetObjectIdString utl obj :vlax-false)
                            (itoa (vla-get-ObjectId obj))
                          )
                          ">%)."
                          prt
                          ">%"
                  )
                  RAD
                  SP
                  EP
         )
      )
      (mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
      (princ)
    )
    James Pertusi

    CAD Applications Consultant
    1 (646) 773 4834
    www.jpcadconsulting.com

  6. #6
    100 Club
    Join Date
    2002-08
    Posts
    180
    Login to Give a bone
    0

    Default Re: Arc Data lisp works only with Arc entities, not curved polyline segments.

    Hi,

    I have make this for a similar problem, if it can give you a way for resolution...
    Code:
    (vl-load-com)
    (defun c:ARTDB ( / js n AcDoc Space ename obj pr nb typ_obj oldim oldlay a_base a_dir
     pt_start pt_end pt_cen rad alpha pt_vtx dist_start dist_end seg_len seg_bulge)
      (defun grdraw-id_arc ( / )
        (grdraw (trans pt_start 0 1) (trans pt_vtx 0 1) 1)
        (grdraw (trans pt_vtx 0 1) (trans pt_end 0 1) 1)
        (grdraw (trans pt_start 0 1) (trans pt_cen 0 1) 3)
        (grdraw (trans pt_cen 0 1) (trans pt_end 0 1) 3)
      )
      (defun add_mt_arc ( / ins_txt h_t)
        (initget 9)
        (setq ins_txt (getpoint (trans pt_cen 0 1) "\nPoint d'insertion des informations de l'arc?: "))
        (initget 6)
        (setq h_t (getdist ins_txt (strcat "\nTaille du texte <" (rtos (getvar "textsize")) ">: ")))
        (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
        (vla-addMtext Space
          (vlax-3d-point (trans ins_txt 1 0))
          0.0
          (strcat
            "{\\fArial Narrow|b0|i0|c0|p34;"
            "A = " (angtos (- pi (* 2 alpha)) 0 4) "%%d"
            "\\PR = " (rtos rad 2 3)
            "\\PT = " (rtos (distance pt_start pt_vtx) 2 3)
            "\\PD = " (rtos seg_len 2 3)
            "\\PB = " (rtos (- (distance pt_cen pt_vtx) (abs rad)) 2 3)
            "}"
          )
        )
        (entmod
          (append
          (vl-remove-if
            (function
              (lambda (x)
                (or (member (car x) '(90 63 421 45))
                  (< 419 (car x) 440)
                )
              )
            )
            (entget (entlast))
          )
          (list
            '(90 . 1)
            '(63 . 41)
            '(421 . 16770196)
            '(45 . 1.5)
          )
          )
        )
        (entupd (entlast))
      )
      (princ "\nSélectionner des Arcs/PolyArcs .")
      (setq
        js
        (ssget
          '((-4 . "<OR")
            (-4 . "<AND")
              (0 . "POLYLINE")
              (-4 . "<NOT")
                (-4 . "&") (70 . 126)
              (-4 . "NOT>")
            (-4 . "AND>")
            (0 . "LWPOLYLINE,ARC")
            (-4 . "OR>"))
        )
        n -1
      )
      (cond
        (js
          (setq
            AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
            Space
              (if (= 1 (getvar "CVPORT"))
                (vla-get-PaperSpace AcDoc)
                (vla-get-ModelSpace AcDoc)
              )
            nb 0
          )
          (cond
            ((null (tblsearch "LAYER" "Info ARTDB des Arcs"))
              (vlax-put (vla-add (vla-get-layers AcDoc) "Info ARTDB des Arcs") 'Color "5")
            )
          )
          (setq
            oldim (getvar "dimzin")
            oldlay (getvar "clayer")
            a_base (getvar "ANGBASE")
            a_dir (getvar "ANGDIR")
          )
          (setvar "dimzin" 0) (setvar "clayer" "Info ARTDB des Arcs")
          (setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
          (repeat (sslength js)
            (setq
              ename (ssname js (setq n (1+ n)))
              obj (vlax-ename->vla-object ename)
              pr -1
              nb 0
            )
            (setq typ_obj (vla-get-ObjectName obj))
            (if (eq typ_obj "AcDbArc")
              (progn
                (setq
                  pt_start (vlax-get obj 'StartPoint)
                  pt_end (vlax-get obj 'EndPoint)
                  pt_cen (vlax-get obj 'Center)
                  rad (vlax-get obj 'Radius)
                  alpha (* (vlax-get obj 'TotalAngle) 0.5)
                  seg_len (vlax-get obj 'ArcLength)
                  pt_vtx (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) (+ rad (* rad (1- (/ 1 (cos alpha))))))
                  nb (1+ nb)
                )
                (grdraw-id_arc)
                (add_mt_arc)
              )
              (repeat (fix (vlax-curve-getEndParam obj))
                (setq
                  dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
                  dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
                  pt_start   (vlax-curve-GetPointAtParam obj pr)
                  pt_end (vlax-curve-GetPointAtParam obj (1+ pr))
                  seg_len (- dist_end dist_start)
                  seg_bulge (vla-GetBulge obj pr)
                )
                (if (not (zerop seg_bulge))
                  (progn
                    (setq
                      rad (/ seg_len (* 4.0 (atan seg_bulge)))
                      alpha (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
                      pt_cen (polar pt_start alpha rad)
                      pt_vtx (polar pt_start (- alpha (* pi 0.5)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
                      alpha (if (< (* 2.0 (atan seg_bulge)) 0) (- pi (* 2.0 (atan seg_bulge))) (* 2.0 (atan seg_bulge)))
                      nb (1+ nb)
                    )
                    (grdraw-id_arc)
                    (add_mt_arc)
                  )
                )
              )
            )
          )
          (setvar "dimzin" oldim) (setvar "clayer" oldlay)
          (setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
        )
      )
      (prin1)
    )
    You select all polylines (heavy or light) and arc, iteratively you annotate the arc.

    NB: You can give "X:/AutoCAD 2018/Drawings/Callouts.dwg" if you want that I try to resolve your code

  7. #7
    I could stop if I wanted to jpcadconsulting347236's Avatar
    Join Date
    2011-09
    Posts
    258
    Login to Give a bone
    0

    Default Re: Arc Data lisp works only with Arc entities, not curved polyline segments.

    Made some more progress!!!

    With the addition of Lee Mac's "GetObject ID" (in red) and some pilfered code from Bruno Valsecchi (in green) I have it working (only with arc objects though). Thanks to both of you!!! And to Tharwat... as usual.

    I'd still like to get it working on all curved objects (segments of splined and fit polylines), but I'm thrilled it's working!

    Code:
    (defun c:CurveTagTEST (/ ent obj CL SCL CID SP EP RAD AL)
    
    (setvar 'ATTDIA 0)
    
    (setq CL (getvar "CLAYER"))
    
    ;;;;; Collect units information and set scale
    (cond ((= (getvar "INSUNITS") 1) (setq SCL 1))
          ((= (getvar "INSUNITS") 2) (setq SCL 0.08333))
          ((= (getvar "INSUNITS") 4) (setq SCL 25.4))
          ((= (getvar "INSUNITS") 5) (setq SCL 2.54))
          ((= (getvar "INSUNITS") 6) (setq SCL 0.0254))
          (t (alert "Current DWG set to non-standard units.  Check UNITS settings"))
    )
    
    (defun GetObjectID ( obj doc )
       ;; Lee Mac
       (if
         (eq "X64"
           (strcase
             (getenv "PROCESSOR_ARCHITECTURE")
           )
         )
         (vlax-invoke-method
           (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
         )
         (itoa (vla-get-Objectid obj))
       )
     )
    
    
    
    ;;;;; Collect arc data
    
    (if (setq ent (car (entsel "\nSelect arc: ")))
    (progn
    
    (setq obj (vlax-ename->vla-object ent)
    
    AL(strcat "%<\\AcObjProp Object(%<\\_ObjId "
                         (GetObjectID obj doc) ">%).Arclength \\f \"%lu4%pr2\">%"
                       )
    
    RAD (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                         (GetObjectID obj doc) ">%).Radius \\f \"%lu4%pr2\">%"
                       )
    
    SP (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                         (GetObjectID obj doc) ">%).Startpoint \\f \"%lu4%pt3\">%"
                       )
    
    EP (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                         (GetObjectID obj doc) ">%).Endpoint \\f \"%lu4%pt3\">%"
                       )
    )
    )
    )
    
    (setq CID (getstring "\nEnter Curve ID: "))
    
    
    ;;;;; Bring in block "MNLA Curve Tag r00" from Callouts.dwg
    
    (defun open_dbx (dwg / dbx)
       (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
          (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
          (setq dbx (vlax-create-object
          (strcat "ObjectDBX.AxDbDocument."
             (substr (getvar "ACADVER") 1 2)
             )
          )
       )
    )
    (vla-open dbx dwg)
    dbx
    )
    (setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
    (vla-CopyObjects
    Dbx
    (vlax-safearray-fill
    (vlax-make-safearray vlax-vbObject '(0 . 0))
    (list (vla-item (vla-get-blocks dbx) "MNLA Curve Tag r00"))
    )
    (vla-get-blocks
    (vla-get-activedocument (vlax-get-acad-object))
    )
    )
    (vlax-release-object dbx)
    
    
    
    ;;;;; Insert and populate block
    
    (command "-layer" "Make" "L-ANNO-SYMB" "Color" "3" "L-ANNO-SYMB" "Ltype" "CONTINUOUS" "" "Plot" "P" "" "")
    (setvar "CLAYER" "L-ANNO-SYMB")
    
    
    (setq p (getpoint "\n Specify point :"))
    
      (command "_.-insert"
    
               "MNLA Curve Tag r00"
               "Scale"
               SCL
               "_none"
    
               p
    
               ""
    
               CID
               AL
               RAD
               SP
               EP
    )
    
    (setvar "CLAYER" CL)
    
    (princ)
    )
    James Pertusi

    CAD Applications Consultant
    1 (646) 773 4834
    www.jpcadconsulting.com

Similar Threads

  1. Please Help! Model Surface Patterns on Curved wall profiles and curved wall segments
    By nealasullivan429203 in forum Revit Architecture - Tips & Tricks
    Replies: 1
    Last Post: 2015-04-28, 07:08 PM
  2. Different colours for separate polyline segments
    By Wish List System in forum AutoCAD Wish List
    Replies: 2
    Last Post: 2015-04-13, 12:04 PM
  3. Get Polyline segments
    By cadplayer in forum AutoLISP
    Replies: 37
    Last Post: 2015-02-06, 11:33 PM
  4. Converting line segments into polyline
    By VBOYAJI in forum AutoCAD Map 3D - General
    Replies: 9
    Last Post: 2007-06-25, 01:56 PM
  5. Wipeouts to Allow Curved Segments
    By acadwishlist in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2007-03-02, 05:55 PM

Posting Permissions

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