Lisp edit to loop user input and to change first block

[wian.meier]

Good day all,

I've done a bit of work on the on the lisp that @dlanorh wrote. the lisp he wrote placed different blocks (determined by the angle of the polyline) on each vertices of a polyline.

I've added "Branch code" that does the same, but for any branches connected to the main polyline (it must be selected by the user) and it places a joint (fibre joint) at the intersection point. It works, however there are cases where I have multiple branches so i need it to loop up until the user input stops.

The second problem that I have is when I select the branch and place the poles, it will place a 5m 150-175 pole along with a joint at the intersection, which is correct. However the main part of the code has already placed a pole on the intersection point and on top of that it will possibly place a thinner pole.

Would it be possible to have a thicker pole placed on the intersection point?

I've attached a sample DWG and a screencast of what I am trying to do.

(defun @delta (a1 a2)
  (cond ( (> a1 (+ a2 pi)) (+ a2 pi pi (- a1)))
        ( (> a2 (+ a1 pi)) (- a2 a1 pi pi))
        (t (- a2 a1))
  )
)

(defun c:test ( / c_doc c_spc ent sp ep pt ang blk lang)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ent (car (entsel "\nSelect Polyline : "))
        sp 0.0
        ep (vlax-curve-getendparam ent)
  )
  (while (<= sp ep)
    (setq pt (vlax-curve-getpointatparam ent sp)
          ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent sp))
    );end_setq
    (cond ( (or (zerop sp) (= sp ep)) (setq blk "5m 150-175"))
          (t (setq blk (if (< (abs (@delta lang ang)) (/ pi 12.0)) "5m 100-125" "5m 150-175")))
    )
    (vlax-invoke c_spc 'insertblock pt blk 1 1 1 0)
    (setq sp (1+ sp) lang ang)
  );end_while
  
  ; Possible code to prompt user if there are any branches
  
  
  ;Branch code - Repeat this up until user selection stops
  ;==============================================================================
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ent (car (entsel "\nSelect Polyline : "))
        sp 0.0
        ep (vlax-curve-getendparam ent)
  )
  
  (setq pt (vlax-curve-getpointatparam ent sp)); This sets first point for the joint to be placed
  
  ;Determining the joint size
  (setq e (tblsearch "layer" (cdr (assoc 8 (entget ent))))) ;Searches for cable layer name
  (setq CSize (cdr (assoc 2 e)))
     (if (= CSize "36F Aerial")
			(command "_.INSERT" "72F Joint" pt "" "")
			(command "_.INSERT" "24F Joint" pt "" "")
	 );end_if
  
  (while (<= sp ep)
    (setq pt (vlax-curve-getpointatparam ent sp)
          ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent sp))
    );end_setq
    (cond ( (or (zerop sp) (= sp ep)) (setq blk "5m 150-175"))
          (t (setq blk (if (< (abs (@delta lang ang)) (/ pi 12.0)) "5m 100-125" "5m 150-175")))
    )
    (vlax-invoke c_spc 'insertblock pt blk 1 1 1 0)
    (setq sp (1+ sp) lang ang)
  );end_while 
)
)

[johnyDFFXO]

Something went wrong with your screencast... HERE's  the link.

Nice explanation btw.

[wian.meier]

Thank you for that! I have no clue how I've missed it!

[wian.meier]

I've figured out how to loop the branch code.

This is what I tried before:

(while
   ;Insert branch code here
)
  

This was the solution:

( while t
  ;Insert branch code here
)

Sometimes my own stupidity amazes me. 

Though I am still thinking of a way to change the block of the first pole or to delete the block at the starting vertex and replace it with a new pole. 

[Moshe-A]

@wian.meier ,

( while t
  ;Insert branch code here
)

if text expr is always T it would be an infinite loop, is that what you want? 😀

moshe

[wian.meier]

With my limited experience and knowledge this seems to be the best solution, so what it will do is it will infinitly ask the user to select a branch, once the user hits escape/enter it will bring back a nil value that stops the code. It's not the best but it works.

Though what I am worried about is if the setq values gets stored and not cleaned. I'll have to test and see.

Another approach I thought of is to count the amount of intersections and to use the repeat function to repeat the branch code "x" amount of times

[ВeekeeCZ · Accepted solution]

Try this code. Use RT click when you're done.

It also can be selected all at once.

(defun @Anonymous (a1 a2)
  (cond ( (> a1 (+ a2 pi)) (+ a2 pi pi (- a1)))
	( (> a2 (+ a1 pi)) (- a2 a1 pi pi))
	(t (- a2 a1))
	)
  )

(defun c:test ( / c_doc c_spc ent sp ep pt ang blk lang s i e l a sel idx branch)
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
	c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
  
  (if (setq ent (car (entsel "\nSelect MAIN Polyline : ")))
    (progn
      (setq sp 0.0
	    ep (vlax-curve-getendparam ent))
      (while (<= sp ep)
	(setq pt (vlax-curve-getpointatparam ent sp)
	      ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent sp))
	      );end_setq
	(cond ( (or (zerop sp) (= sp ep)) (setq blk "5m 150-175"))
	      (t (setq blk (if (< (abs (@delta lang ang)) (/ pi 12.0)) "5m 100-125" "5m 150-175")))
	      )
	(vlax-invoke c_spc 'insertblock pt blk 1 1 1 0)
	(setq sp (1+ sp) lang ang)
	)))
  
  (princ "\nSelect branches, ")
  (while (setq sel (ssget ":S" '((0 . "LWPOLYLINE"))))
    (repeat (setq idx (sslength sel))
      (setq sp 0.0
	    ent (ssname sel (setq idx (1- idx)))
	    ep (vlax-curve-getendparam ent))
      
      (if (setq s (ssget "_X" '((0 . "INSERT") (2 . "5m 100-125,5m 150-175"))))
	(repeat (setq i (sslength s))
	  (setq e (ssname s (setq i (1- i)))
		l (cons (cons (cdr (assoc 10 (entget e))) e) l))))
      (while (<= sp ep)
	(setq pt (vlax-curve-getpointatparam ent sp)
	      ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent sp)))
	(cond ((or (zerop sp) (= sp ep)) (setq blk "5m 150-175"))
	      (t (setq blk (if (< (abs (@delta lang ang)) (/ pi 12.0)) "5m 100-125" "5m 150-175")))
	      )
	(if (setq a (assoc pt l)) (entdel (cdr a)))
	(vlax-invoke c_spc 'insertblock pt blk 1 1 1 0)
	(setq sp (1+ sp) lang ang))
      (command "_.INSERT"
	       (if (= "36F Aerial" (cdr (assoc 2 (tblsearch "layer" (cdr (assoc 8 (entget ent)))))))
		 "72F Joint"
		 "24F Joint")
	       "_non" (vlax-curve-getstartpoint ent) "" "")))
  (princ)
  )

Edit: Code updated to accommodate branches. The second selection can be multiple.

[wian.meier]

Wow this is amazing thank you! Could you possibly add comments to what each module does, it makes it easier for my to learn from it and understand how it works. Though It's a lot of extra effort.

There is one last thing, it seems that it's not placing a joint on the branched of cable,

Is it possible to add this when selecting the cables?

  (setq pt (vlax-curve-getpointatparam ent sp)); This sets first point for the joint to be placed
  
  ;Determining the joint size
  (setq e (tblsearch "layer" (cdr (assoc 8 (entget ent))))) ;Searches for cable layer name
  (setq CSize (cdr (assoc 2 e)))
     (if (= CSize "36F Aerial")
			(command "_.INSERT" "72F Joint" pt "" "")
			(command "_.INSERT" "24F Joint" pt "" "")
	 );end_if

[ВeekeeCZ]

Yeah, I did update the code to accommodate that.

Can't do the commentaries right now... look into it yourself and gimme some lines you do not understand. Though I did not look into dlanorhs lines very much...

[wian.meier]

Alright so I used your code to replace my branch code and I added in the joint function and it is working like a charm! Thank you very much for all the help!

[wian.meier]

@ВeekeeCZ 

Haha I did the same before checking your updated code, simple me. It is working perfectly

[ВeekeeCZ]

Good!

Note that you can mark just branches - just hit <enter> for the mainline selection, it does not crash.

... ou can modify the prompt to something like this:

Select the mainline <just branches>: 

[ВeekeeCZ]

Here is an elaboration of a part of your code. Follow the numbers to understand the order.

Look what I've done with this part in my code and try to fix the redundancy I have missed.

  (setq e (tblsearch "layer" 			  ;; 4 get layer definition list (similar to point 1, just about a layer
	    (cdr				  ;; 3 get layername itself - "layername"
	      (assoc 8				  ;; 2 get a pair associated with number 8, which is a layer name!!!!!!! eg. '(8 . "layername")
		     (entget ent)))))             ;; 1 get definition list of ent (your polyline)                
  (setq CSize (cdr				  ;; 6 get layername itself - "layername"... 
		(assoc 2 e)))			  ;; 5 get a pair associated with number 2, which is a layer name! AGAIN!! eg. '(8 . "layername")
     (if (= CSize "36F Aerial")
			(command "_.INSERT" "72F Joint" pt "" "")
			(command "_.INSERT" "24F Joint" pt "" "")
	 );end_if