Jump to content

Please help me for text on Polyline with block


Bittuds1996

Recommended Posts

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

Link to comment
Share on other sites

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)     

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...