Topic: Draw new polyline

[bprabhakar001]

Dear All,

I need a funtion to draw a polyline from the existing polyline coordintes reading with "AddLightWeightPolyline".Would you please  guide me .
        (if  (setq sel_set (ssget "X" '((0 . "POLYLINE,LWPOLYLINE") )))
                (progn (Setq n1 0)
                (while (< n1 trail_len)
                (setq pl_name (ssname sel_set  n1)pl_obj (vlax-ename->vla-object pl_name))
      (setq list (vlax-get pl_obj1 'coordinates))
        ))).....Please guide me affter that.

Thaking you,
Prabhakar.B

[CAB]

Something like this will do it.

Code: [Select]

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq space
         (if (zerop (vla-get-activespace doc))
           (if (= (vla-get-mspace doc) :vlax-true)
             (vla-get-modelspace doc) ; active VP
             (vla-get-paperspace doc)
           )
           (vla-get-modelspace doc)
         )
  )

  (if (setq sel_set (ssget "X" '((0 . "POLYLINE,LWPOLYLINE"))))
    (progn
      (setq i -1)
      (while (setq ename (ssname sel_set (setq i (1+ i))))
        (setq pl_obj (vlax-ename->vla-object ename))
        (setq coords (vlax-get pl_obj 'coordinates))
        (vlax-invoke space "AddLightweightPolyline" coords)

      )
    )
  )

[CAB]

Another way to approach it is to copy the objects.

Code: [Select]

  (if (setq sel_set (ssget "X" '((0 . "POLYLINE,LWPOLYLINE"))))
    (progn
      (setq i -1)
      (while (setq ename (ssname sel_set (setq i (1+ i))))
        (setq pl_obj (vlax-ename->vla-object ename))
        (setq new_objs (cons (vla-Copy pl_obj) new_objs))
      )
    )
  )

[ElpanovEvgeniy]

Dear All,

I need a funtion to draw a polyline from the existing polyline coordintes reading with "AddLightWeightPolyline".Would you please  guide me .

Code: [Select]

  ; If your have list point:
(setq lst '((0. 0. 0.)(10. 0. 0.)(10. 10. 0.)(0. 10. 0.)))
  ; Variant 1 (vla...)
(setq
  lw-obj (vla-AddLightweightPolyline
           (vla-get-modelspace
             (vla-get-activedocument
               (vlax-get-acad-object)
             ) ;_  vla-get-activedocument
           ) ;_  vla-get-modelspace
           (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray
                 vlax-vbDouble
                 (cons 0 (1- (* (length lst) 2)))
               ) ;_ vlax-make-safearray
               (apply (function append)
                      (mapcar
                        (function
                          (lambda (x)
                            (list (car x) (cadr x))
                          ) ;_  lambda
                        ) ;_  function
                        lst
                      ) ;_  mapcar
               ) ;_  apply
             ) ;_ vlax-safearray-fill
           ) ;_  vlax-make-variant
         ) ;_  vla-AddLightweightPolyline
) ;_  setq

  ; Variant 2 (ename...)
(setq
  lw-ename (entmakex
             (append
               (list
                 '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 (cons 90 (length lst))
                 (cons 70 0) ; if closet (cons 70 1)
               ) ;_  list
               (mapcar
                 (function
                   (lambda (x)
                     (cons 10 x)
                   ) ;_  lambda
                 ) ;_  function
                 lst
               ) ;_  mapcar
             ) ;_  append
           ) ;_  entmakex
) ;_  setq

[bprabhakar001]

Thank you,

After all of your support I have done my job.Please suggest the modification to improve the speed.I need to work on 30mb files.

Purpose:Copy the Object data from exiting lines.Redraw the new polyline with same coordintes and map the same  object data.
Autocad Map 2004 or latest vesrion.

Code: [Select]

(CODE:

(defun c:recappl ()
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq space
(if (zerop (vla-get-activespace doc))
   (if (= (vla-get-mspace doc) :vlax-true)
     (vla-get-modelspace doc) ; active VP
     (vla-get-paperspace doc)
   )
   (vla-get-modelspace doc)
)
  )

  (if (setq sel_set (ssget "x" '((0 . "POLYLINE,LWPOLYLINE"))))
    (progn
      (setq i -1)
      (while (setq ename (ssname sel_set (setq i (1+ i))))
(setq source_obj (vlax-ename->vla-object ename))
(setq coords (vlax-get source_obj 'coordinates))
(setq layer_O (vlax-get source_obj 'layer))
(setq color_o (vlax-get source_obj 'color))
(command "-layer" "m" layer "" "")
(setq new_obj (vlax-invoke space "AddLightweightPolyline" coords)
)
(vla-put-color new_obj color_o)
(vla-put-layer new_obj layer_o)
(setq target_obj (entlast))
(if (setq tbllist (ade_odgettables ename))
  (progn (COPY_DATA ename target_obj)
(redraw target_obj 4)
(vla-delete source_obj)
  )
)
      )
    )
  )

)


;;; Copy object data from the source object to the target object.

(defun COPY_DATA (source_obj       target_obj ; overwrite flag
  /     ct       ct2 cttemp   fld
  fldnme    fldnamelist fldtyp   fldtypelist
  len     numrec    OK tbl   tbllist
  tbldef    tblstr    val vallist
)

  ;;
  ;; access all OD tables from source object
  ;;
  (if (setq tbllist (ade_odgettables ename))
    (progn
      ;;
      ;; for each table on source object
      ;;
      (foreach tbl tbllist
(progn
  ;;
  ;; build list of field names
  ;;
  (setq tbldef (ade_odtabledefn tbl))
  (setq tblstr (cdr (nth 2 tbldef)))
  (setq fldnamelist ())
  (setq fldtypelist ())
  (foreach fld tblstr
    (setq fldnme (cdr (nth 0 fld)))
    (setq fldtyp (cdr (nth 2 fld)))
    (setq fldnamelist (append fldnamelist (list fldnme)))
    (setq fldtypelist (append fldtypelist (list fldtyp)))
  )
  ;;
  ;; for each record on source object
  ;;
  (setq numrec (ade_odrecordqty ename tbl))
  (setq ct 0)
  (while (< ct numrec)
    ;;
    ;; build list of values
    ;;
    (setq cttemp 0)
    (setq vallist ())
    (foreach fld fldnamelist
      (setq typ (nth cttemp fldtypelist))
      (setq cttemp (+ cttemp 1))
      (setq val (ade_odgetfield ename tbl fld ct))
      (if (= typ "Integer")
(setq val (fix val))
      )
      (setq vallist (append vallist (list val)))
    )
    ;;
    ;; add a record to target object
    ;;
    (ade_odaddrecord target_obj tbl)
    ;;
    ;; populate target record with values from source record
    ;;
    (setq ct2 0)
    (while (< ct2 (length vallist))
      (setq val (nth ct2 vallist))
      (setq fld (nth ct2 fldnamelist))
      (setq ct2 (+ ct2 1))
      (ade_odsetfield target_obj tbl fld ct val)
    )
    (setq ct (+ ct 1))
  ) ;while
)
      ) ;foreach
    )
  ) ;if

) ;COPY_DATA

)
Best Regards,
Prabhakar.B

Edit: Code tags added

[CAB]

Prabhakar
If you use this (vla-Copy pl_obj) the new object has all the properties of the old object & no need to change things like layer or color.
Also note that using (vla-CopyObjects pl_obj) may do all that you need. See this from the help file on vla-CopyObjects:

During the CopyObjects operation, objects that are owned or referenced by the primary objects in the Objects parameter will also be copied.

Maybe one of the vLisp experts will verify or you can give it a try.


As for this line:

Code: [Select]

(command "-layer" "m" layer "" "")
it needs to be before the WHILE loop so it is only executed once, not every time you process a pline.

In place of the command you could use this:

Code: [Select]

(setq lyrcollection (vla-get-layers doc))
  ;; create or get the layer
  (setq lyrobj (vla-add lyrcollection lyrName))
  (vla-put-color lyrobj acred) ; change the color

[ElpanovEvgeniy]

As functions work?
 ade_odgettables
 ade_odtabledefn
 ade_odrecordqty
 ade_odgetfield
 ade_odaddrecord

[CAB]

OK, scratch the vla-copyObjects suggestion:
http://tinyurl.com/r6dej

[bprabhakar001]

Dear Cab,

Thanking you for the suggestions u has made for me.

Due to some of unknown problem I had the need of this program. We are exported data from AutoCAD to shape and again re imported after certain modification in Arc view.

Again after the modification from cad to arc view (Shp files) we found problems.
I have posted the same thing in my previous AutoDesk discussion group as well as in Augi. But I did not get answer for that.
http://forums.augi.com/showthread.php?t=47285


That's why I have thought to regenerate data and export to shape files. I was used VL-COPY I did not successes. I will try with VL-COPYOBJECTS.

Thanking you,
Prabhakar.B

[bprabhakar001]

As functions work?
 ade_odgettables
 ade_odtabledefn
 ade_odrecordqty
 ade_odgetfield
 ade_odaddrecord

Dear Friend,

These are the functions of AutoCADMAP3D software. Yes you may be strange. I have seen around the Vanilla are mostly AutoCAD User's only.

I could not for get your help of my previous request. Thanks once again for u support.

Thanking You,
Prabhakar.B

[ElpanovEvgeniy]

Dear Friend,

These are the functions of AutoCADMAP3D software. Yes you may be strange. I have seen around the Vanilla are mostly AutoCAD User's only.

I could not for get your help of my previous request. Thanks once again for u support.

Thanking You,
Prabhakar.B

I only want to find out, that they do make. (Return Values)

[Mark]

Dear Friend,

These are the functions of AutoCADMAP3D software. Yes you may be strange. I have seen around the Vanilla are mostly AutoCAD User's only.

I could not for get your help of my previous request. Thanks once again for u support.

Thanking You,
Prabhakar.B

I only want to find out, that they do make. (Return Values)

- Evgeniy
In the morning ( 7AM EDT ) I'll send you the Map Dev Help file.

[ElpanovEvgeniy]

Thanks! I shall study.
Probably, I can write the program, not using AutoCADMAP3D software...

[Mark]

Thanks! I shall study.
Probably, I can write the program, not using AutoCADMAP3D software...

Here ya go.

[ http://www.theswamp.org/lilly_pond/mark/acmaplisp.zip ]

[bprabhakar001]

Hi,

One of the good feature in mapfunctions to get the object properties.

(ade_expreval [ename] expr type)

Ex:
(setq ename (car (entsel "Select an object:")))
(setq objcolor (ade_expreval ename  ".color" "string")))

Regards,
Prabhakar.B