LISP ROUTINE TO ADD BLOCK AT END OF A POLYLINE

[Ajohnson0]

I am need to create a polyline that is the length of 52" and automatically inserts a block at the end of it. Is this possible?

[dlanorh]

Yes, but not with the information you've supplied so far.

[Ajohnson0]

What else would you need? new at lisp routines, does my screencast with audio show up?

[marko_ribar]

Use (getpoint) function to aquire points, then (entmake/x) line/polyline and finally use command INSERT or if you want (vla-insertblock) to insert your BLOCK at the end point of previously created line/polyline... Of course all this through LISP routine...

[Ajohnson0]

I do not have experience writing lisp routines, that is the purpose of this post.

[dlanorh]

I can see the screencast, but it is not legible enough to work out :

Layer for the Line/Polyline and width
Is the angle free (as in the user decides) or is there a certain angle
Block name to insert, and is it always the end point and the same block(s)
Block final layer and is it always the same layer(s)

[ВeekeeCZ]

A single-straight segment of a polyline?

[Ajohnson0]

@dlanorh 

Layer for the Line/Polyline and width Column_lock/3
Is the angle free (as in the user decides) or is there a certain angle free angle
Block name to insert, and is it always the end point and the same block(s) CL/always at the end/same block
Block final layer and is it always the same layer(s) HARDWARE/yes

[dlanorh]

OK, maybe an hour as I also have to finish something of my own.

[Ajohnson0]

@dlanorh appreciate your assistance

[ВeekeeCZ]

This should be a just a prove of concept... I thought that the last complex expression could be just (getvar 'lastpoint), but that did not work.

See HERE  You need a block with polyline inside. See the block, direction of polyline matters!

(defun c:b48 ( / p)
  (command "_insert" "b48" "_scale" 1 PAUSE PAUSE
	   "_explode" "last"
	   "_insert" "be" "_scale" 1 "_r" 0 (trans (cdr (assoc 10 (reverse (entget (entlast))))) 0 1))
  (princ)
  )

[dlanorh]

OK Try this

(defun rh:get_pt (msg pt)
  (initget 1)
  (if pt (setq pt (getpoint pt (strcat "\nSelect " msg " Point : "))) (setq pt (getpoint (strcat "\nSelect " msg " Point : "))))
  (reverse (cdr (reverse pt)))
);end_defun

(vl-load-com)

(defun c:LB (/ *error* sv_lst sv_vals c_doc c_spc len s_pt i_pt e_pt l_obj b_obj)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn 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 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (initget 6)
  (setq len (cond ( (getreal "\nEnter Line Length <52.0> : ")) (52.0))

  (setq s_pt (rh:get_pt "Start" nil)
        i_pt (rh:get_pt "Direction" s_pt)
        e_pt (polar s_pt (angle s_pt i_pt) len)
        l_obj (vlax-invoke c_spc 'addlightweightpolyline (apply 'append (list s_pt e_pt)))
        e_pt (reverse (cons 0.0 (reverse e_pt)))
  );end_setq
  
  (mapcar '(lambda (x y) (vlax-put l_obj x y)) (list 'layer 'constantwidth) (list "Column_lock" 3))
  (setq b_obj (vlax-invoke c_spc 'InsertBlock e_pt "CL" 1 1 1 0));THIS ASSUMES THE BLOCK SCALE IS 1 (x y & z) AND ROTATION IS 0
  (vlax-put b_obj 'layer "HARDWARE")

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun
  

Assumptions, as I didn't ask:

Block Scales are 1 and rotation is 0

Drawing units are in inches

If these are not correct please advise and I will adjust

Ammended code above to allow any length of line (default 52.0)

[Ajohnson0]

@dlanorh I loaded this and it says rh is an unknown command

[Kent1Cooper · Accepted solution]

Can it be as simple as this?

(defun C:WHATEVER (/ pt1 pt2)
  (command
    "_.pline" (setq pt1 (getpoint "\nStart of Pline: "))
    "_width" 3 3 (setq pt2 (getpoint pt1 "\nDirection: "))
    "_u" ; back off that segment
    "_non" (polar pt1 (angle pt1 pt2) 52) "" ; new end in that direction at required distance
    "_.chprop" "_last" "" "_layer" "Column_lock" ""
    "_.insert" "CL" "@" "" "" ""
    "_.chprop" "_last" "" "_layer" "HARDWARE" ""
  )
)

[assuming, of course, that the Layers and Block definition already exist in the drawing....] 

[dlanorh]

Sorry, type LB to run it

[Ajohnson0]

@Kent1Cooper I have a novice question here. Is there a way to make the CL block stay at the end the pline if I need to move it? or better yet erase it as I would have to erase both entities vs erasing just one (if they are grouped or whatever)

[Sea-Haven]

My $0.05 this is front end then use code already posted. The code can be changed very simply to remember last entry.

[dlanorh]

Try the attached. Creates an anonymous group of the line and block. type LBG to run

(defun rh:get_pt (msg pt)
  (initget 1)
  (if pt (setq pt (getpoint pt (strcat "\nSelect " msg " Point : "))) (setq pt (getpoint (strcat "\nSelect " msg " Point : "))))
  (reverse (cdr (reverse pt)))
);end_defun

(defun rh:make_group ( doc gname lst / c_grps n_grp rtn)
  (setq c_grps (vla-get-groups doc)
        n_grp (vlax-invoke c_grps 'add gname)
  );end_setq
  (vlax-invoke n_grp 'appenditems lst)
);end_defun

(vl-load-com)

(defun c:LBG (/ *error* sv_lst sv_vals c_doc c_spc len s_pt i_pt e_pt l_obj b_obj)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn 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 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (initget 6)
  (setq len (cond ( (getreal "\nEnter Line Length <52.0> : ")) (52.0)))

  (setq s_pt (rh:get_pt "Start" nil)
        i_pt (rh:get_pt "Direction" s_pt)
        e_pt (polar s_pt (angle s_pt i_pt) len)
        l_obj (vlax-invoke c_spc 'addlightweightpolyline (apply 'append (list s_pt e_pt)))
        e_pt (reverse (cons 0.0 (reverse e_pt)))
  );end_setq
  
  (mapcar '(lambda (x y) (vlax-put l_obj x y)) (list 'layer 'constantwidth) (list "Column_lock" 3))
  (setq b_obj (vlax-invoke c_spc 'InsertBlock e_pt "CL" 1 1 1 0));THIS ASSUMES THE BLOCK SCALE IS 1 (x y & z) AND ROTATION IS 0
  (vlax-put b_obj 'layer "HARDWARE")
  (rh:make_group c_doc "*" (list l_obj b_obj))
  
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

[Ajohnson0]

is there anyway to group the 2 together so that they aren't separate entities?

[Kent1Cooper]

---

@Ajohnson0 wrote:

is there anyway to group the 2 together so that they aren't separate entities?

---

Put them into a Group or a Block together.  Since they're on different Layers, they can't be a single entity in the strict sense, but a Block containing them can, and a Group containing them can sort of function that way.