Need a list so this code can have multiple blocks from a list to insert blocks

[Anonymous]

In this code I can insert the same block with different distances,  dimensions (X Y)  and text  so there are already 3 lists.  Now i want the code also to insert diferent blocks by blockname

Here is the code I want to append the list for blocks in.

(defun c:detectie (/ distcum distlst doc enm obj spc txtlst xylst o p)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)

  (setq distLst '(1.0 11.0 12.0 25.0 )) ; distance detection loop 

  ;;(setq distLst '(1.0    9.0    26.0   11.0   9.0    58.0   100.0  124.0 )) 

  (setq xyLst   '((1 2.5) (8 1) (18 1) (1 2) )) ; detection loop size 

  ;;(setq xyLst   '((1 2)  (20 1) (1 2)  (1 2)  (1 2)  (1 2)  (5 1)  (5 1) ))

  (setq txtLst  '("D011" "D014" "D017" "D0110" )) ; loop numbers

  ;;(setq txtLst  '("D011" "D012" "D013" "D014" "D015" "D016" "D017" "D018")) 
 

 (if (and (setq enm (car (entsel "\n >> Select pline >>")))
	   (setq obj (vlax-ename->vla-object enm))
	   (= "AcDbPolyline" (vla-get-objectname obj))
	   (or (< (apply '+ distlst) (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))
	       (progn (alert "Pline is too short. make pline longer!") nil)
	   )
      )
    (progn
      (setvar 'cmdecho 0)
      (command "_.-insert" "SVW-VRI_KABEL_DETECTIELUS_90-G")
      (command nil)
      (setvar 'cmdecho 1)
      (setq distcum 0)
      (setq spc (vla-objectidtoobject doc (vla-get-ownerid obj)))
      (mapcar '(lambda (dist xy txt / ang pt)
		 (setq distcum (+ distcum dist))
		 (setq ang (angle '(0 0 0)
				  (vlax-curve-getfirstderiv obj (vlax-curve-getparamatdist obj distcum))
			   )
		 )
		 (setq pt (vlax-curve-getpointatdist obj distcum))
(command "setvar" "clayer" "N-WE-VW-VRI_DETECTIELUSSEN")
		 (vlax-invoke
		   spc
		   'insertblock
		   pt
		   "SVW-VRI_KABEL_DETECTIELUS_90-G"
		   (car xy)
		   (cadr xy)
		   (car xy)
		   ang
		 )
		 ;; RJP » 2018-11-02
		 ;; Check that we created the text
(command "setvar" "clayer" "N-WE-VW-VRI-T18_DETECTIELUSSEN")
		 (cond ((setq o	(vlax-invoke
				  spc
				  'addtext
				  txt
				  (setq	p (polar (polar pt ang (+ (car xy) 1.40))
					; 1.40 distance to block.
						 (+ ang (* 0.0 pi))
						 -0.225
					; -0.225 distance to pline. ;I want to put this to 0 with alignment middleleft
					  )
				  )
				  0.45	; Hoogte.
				)
			)
			;; Now apply the properties
			(vla-put-rotation o ang)
			(vlax-put o 'alignment 10)
			(vlax-put o 'textalignmentpoint p)
		       )
		 )
	       )
	      distlst
	      xylst
	      txtlst
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

[dbhunia · Accepted solution]

Hi,

As you asked....

---

@Anonymous wrote:

In this code I can insert the same block with different distances,  dimensions (X Y)  and text  so there are already 3 lists.  Now i want the code also to insert diferent blocks by blockname
.............................

---

Try this.......

(defun XXX (Ent distlst txtlst xylst blkLst N / distcum doc enm obj spc o p)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)

  (if (and (setq enm Ent)
	   (setq obj (vlax-ename->vla-object enm))
	   (= "AcDbPolyline" (vla-get-objectname obj))
	   (or (< (apply '+ distlst) (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))
	       (progn (alert "Pline is too short. make pline longer!") nil)
	   )
      )
    (progn
      (setvar 'cmdecho 0)
      (command "_.-insert" (nth N blklst))
      (command nil)
      (setvar 'cmdecho 1)
      (setq distcum 0)
      (setq spc (vla-objectidtoobject doc (vla-get-ownerid obj)))
      (mapcar '(lambda (dist xy txt / ang pt)
		 (setq distcum (+ distcum dist))
		 (setq ang (angle '(0 0 0)
				  (vlax-curve-getfirstderiv obj (vlax-curve-getparamatdist obj distcum))
			   )
		 )
		 (setq pt (vlax-curve-getpointatdist obj distcum))
		 (command "setvar" "clayer" "N-WE-VW-VRI_DETECTIELUSSEN")
		 (vlax-invoke
		   spc
		   'insertblock
		   pt
		   (nth N blklst)
		   (car xy)
		   (cadr xy)
		   (car xy)
		   ang
		 )
		 ;; RJP » 2018-11-02
		 ;; Check that we created the text
		 (command "setvar" "clayer" "N-WE-VW-VRI-T18_DETECTIELUSSEN")
		 (cond ((setq o	(vlax-invoke
				  spc
				  'addtext
				  txt
				  (setq	p (polar (polar pt ang (+ (car xy) 1.40))
					; 1.40 distance to block.
						 (+ ang (* 0.0 pi))
						 -0.225
					; -0.225 distance to pline. ;I want to put this to 0 with alignment middleleft
					  )
				  )
				  0.45	; Hoogte.
				)
			)
			;; Now apply the properties
			(vla-put-rotation o ang)
			(vlax-put o 'alignment 10)
			(vlax-put o 'textalignmentpoint p)
		       )
		 )
	       )
	      (list(nth N distlst))
	      (list(nth N xylst))
	      (list(nth N txtlst))
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)
(defun C:detectie (/)
(setq Ent (car (entsel "\n >> Select pline >>")))
(setq blkLst '("A" "B" "C" "D")) ; Block detection loop (Enter Block Names)
(setq distLst '(1.0 11.0 12.0 25.0 )) ; distance detection loop 
(setq xyLst   '((1 2.5) (8 1) (18 1) (1 2) )) ; detection loop size 
(setq txtLst  '("D011" "D014" "D017" "D0110" )) ; loop numbers
(setq L -1)
(repeat (setq N1 (length blkLst))
	(XXX Ent distlst txtlst xylst blkLst (setq L (+ L 1)))
	(setq N1 (- N1 1))
)
)

[Anonymous]

almost perfect, only there is something wrong now with the lenght of the pline.
i need to make is 40m longer then it need to be?

[dbhunia]

Hi,

In this below line.....

(or (< (apply '+ distlst) (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))

Coed is checking The pline length "(vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))" with the summation of distlst "(apply '+ distlst)" and if "pline length" is greater than "the summation of distlst" then the code will run otherwise it give a alert message "Pline is too short. make pline longer!" ........In your code the summation of distlst is "1.0+11.0+12.0+25.0" is "49.0"......

So you have to adjust here (Blue one) as per your desire pline length.......

(setq distLst '(1.0 11.0 12.0 25.0)) ; distance detection loop

[Anonymous]

Yes the code worked with de sum of the distlist, but somewhere  something  changed.
if I use  

(setq distLst '(1.0 11.0 12.0 25.0))

The pline lenght is ok, but then the detection loops drawn at 1.0 11.0 12.0 and 25.0 meter
somewhere the sum is missing.  for your info I want the loops drawn at 1m 12m 24m and 49m the pline should be minimal 49m +the distance of the detection loop  wich is in this case (1 2) so when the pline is 50m it will be working.

now the pline must be 87 or 88m
 

[Anonymous · Accepted solution]

oops sorry wrong solution,  I fixed the problem by adding an extra list 

changes are blue

(defun XXX (Ent distlst Polylst txtlst xylst blkLst N / distcum doc enm obj spc o p)

(or (< (apply '+ Polylst) (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj )))

(setq txtLst '("D011" "D012" "D013" "D014" )) ;;Detection loopnumbers

(setq Polylst '( 1 11 12 25 )) ;;Polyline lenght

(XXX Ent distlst Polylst txtlst xylst blkLst (setq L (+ L 1)))

works for me, I bet there is a better way to do it, but for now I am happy

I didnt know if I told you but the info in the list I fill with vba and now I will put that in vb.net

So in the end, I will have a dll of vb.net application with the layers all the blocks and a stable tooling (with the lisp you helped me with)

excuse my bad english not my native language  🙂

so many thanks.