Please help me for text on Polyline with block

[Bittuds1996]

Hi All Members

 

Please Please help me for text on Polyline with block

 

 

Sorry for English

S2_A1_CS_LIST_FINAL.dwg

[dlanorh]

Try this

 

(vl-load-com)

(defun c:PVB ( / *error* c_doc c_spc sv_lst sv_vals blk_flg ss pl_ent v_lst cnt c_str t_str b_obj t_obj)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'osmode 'cmdecho 'textstyle)
        sv_vals (mapcar 'getvar sv_lst)
        blk_flg T
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (cond ( (null (tblsearch "BLOCK" "TP")) (setq blk_flg nil)))
  (cond ( (null (tblsearch "LAYER" "Turning Point")) (vlax-put (vla-add (vla-get-layers c_doc) "Turning Point") 'color 1)))
  (cond ( (null (tblsearch "LAYER" "TP-Blocks")) (vlax-put (vla-add (vla-get-layers c_doc) "TP-Blocks") 'color 7)))
  (cond ( (null (tblsearch "STYLE" "ARIAL")) (if (/= (getvar 'textstyle) "STANDARD")(setvar 'textstyle "STANDARD")))
        (t (if (/= (getvar 'textstyle) "ARIAL")(setvar 'textstyle "ARIAL")))
  );end_cond
  
  (prompt "\nSelect Polyline : ")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  
  (cond ( (and blk_flg ss)
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
          (vla-startundomark c_doc)

          (setq pl_ent (ssname ss 0)
                v_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl_ent)))
                cnt 0
          );end_setq
  
          (foreach v_pt v_lst
            (setq c_str (itoa cnt)
                  t_str (strcat "TP" (if (< cnt 100) (while (< (strlen c_str) 3) (setq c_str (strcat "0" c_str))) c_str))
                  b_obj (vla-insertblock c_spc (vlax-3d-point v_pt) "TP" 1 1 1 0)
                  t_obj (vla-addtext c_spc t_str (vlax-3d-point v_pt) 10.0)
                  cnt (1+ cnt)
            );end_setq
            (vlax-put-property b_obj 'layer "TP-Blocks")
            (vlax-put-property t_obj 'layer "Turning Point")
          );end_foreach
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
        )
        ( (not blk_flg) (alert "Block TP NOT found in drawing\n\nPlease Import/Load and restart"))
        ( (not ss) (alert "Nothing Selected"))
  );end_cond
  
  (mapcar 'setvar sv_lst sv_vals)
  (vla-regen c_doc acActiveViewport)
  (princ)
);end_defun

 

It checks if the block is present in the drawing and alerts if not.

 

It checks if text style Arial is present and if not uses standard

 

It checks if layer "Turning Point" is present and if not creates it and does the same with "TP-Blocks" (Block Layer)

 

It took a couple of seconds to run through the 872 Vertices

[Ish]

Use cad tools - www.glamsen.se/CadTools

 

Draw polylines, circles and blocks from coordinates

[BIGAL]

A couple of suggestions Dlannor instead of ch props just change layer, whilst this is not really good programming using "layer make" will make a new layer if does not exists or will ignore if exists. As you have a list of co-ords you can get the half angle of the vertex point and rotate the block to match.

 

(setq c_str (itoa cnt)
                  t_str (strcat "TP" (if (< cnt 100) (while (< (strlen c_str) 3) (setq c_str (strcat "0" c_str))) c_str))
                   cnt (1+ cnt)
)
    (setvar 'clayer "TP-Blocks")
    (vla-insertblock c_spc (vlax-3d-point v_pt) "TP" 1 1 1 0)
    (setvar 'clayer "Turning Point")
    (vla-addtext c_spc t_str (vlax-3d-point v_pt) 10.0)