Help with lisp routine, add blocks to polyline

Hi all,

I want to put blocks on a polyline as a model is from 20 to 20m, but the 20m measured horizontally, using a block with attribute.

Although in my view should work do not understand where the problem arises.

I atached the block "COTAL1.DWG" and the model "lg-mc22_00.dwg"

(vl-load-com)
(princ "\n***The command is CS***")


(defun c:CS (/ pct_0 startpt endpt  )

 (setq acadObject (vlax-get-acad-object))
 (setq acadDocument (vlax-get-property acadObject 'ActiveDocument))
 (setq mSpace (vlax-get-property acadDocument 'Modelspace))
 (setvar "osmode" 32)
 
 (setq pct_0 (getpoint "\nSelect one point on the reference line: "))
 
 (setq Linia_obiect (vlax-ename->vla-object (car (entsel "\nSelect polyline >>"))))
 
 (setq objLength (vlax-curve-getDistAtParam Linia_obiect (vlax-curve-getEndParam Linia_obiect)))
 
 (setq startpt (vlax-curve-getPointAtParam Linia_obiect (vlax-curve-getStartParam Linia_obiect)))
 
 (setq endpt (vlax-curve-getPointAtParam Linia_obiect (vlax-curve-getEndParam Linia_obiect)))
 
 (setq plan_ref (/ (cadr pct_0) 10.0 ))
 
 (setq Dx (car startpt))
 
(while (< Dx (car endpt))
 
(setq pct_pe_l_ref
      (list (car startpt)
        (cadr pct_0))) 
 
(setq Xline (vlax-invoke mSpace 'AddXLine startPt pct_pe_l_ref))

(if
  (setq secondpt (vlax-invoke  Xline 'IntersectWith Linia_obiect 0))
  
  (progn
(setq Dy (/ (- (cadr secondpt) (cadr pct_0)) 10.0 ) )
(command "insert" "C:\\WBLOCK\\COTAL1.DWG" (polar pt 0.0 0.0) 10 10 0 (rtos (+ plan_ref Dy) 2 2))  ; (vl-cmdf "_.scale" "l" "" startPt dis )
));;; end if

(vla-delete Xline)

(setq Dx (+ Dx  20.0 ))
(setq startpt secondpt)
 )
 (gc)
 
(princ)
 )

COTAL1.DWG

lg-mc22_00.dwg

Cote_scurgere_ape v1.2-eng.LSP

Why wouldn't you use the Measure or Divide commands to do the same thing? Both can utilize blocks. I don't think there is any prohibition to using attributed blocks.

I want to add the blocks but distance (20m) to be inserted must be measured horizontally in the x direction, independently of the slope of polyline.

And the attribute to each block represent the elevation point in logitudinal profiles.

The Measure or Divide command use the length of segment between two inserted blocks, but for me this is unknown (is variable).

The constant is horizontal distance 20m.

So you're saying the spacing on the blocks varies?

So you're saying the spacing on the blocks varies?

Yes if look at the example "lg-mc22_00.dwg" i atached you will see how i want to draw the blocks.

Hi all,

I have an old routine that is what I want but put the blocks in each vertex of the polyline.

You can tell me what to change to put blocks only at vertex from 20m to 20m as you can see in second example?

I forget to atach the code.

(princ "\n***Type CS***")


(defun c:CS (/ ent i idx pt ss totparam rot)

 (setq old_cmdecho (getvar "cmdecho"))
 (setq old_osmode (getvar "OSMODE"))
 (setq old_clayer (getvar "clayer"))
 (setq old_ucsview (getvar "ucsview"))
 (setq old_dimzin (getvar "dimzin"))
 (setq old_EXPERT (getvar "EXPERT"))
 (setq oldcol (getvar "CECOLOR"))
 (setq old_error *error*)
 (setvar "cmdecho" 0)
 (setvar "UCSVIEW" 1)
 (setvar "osmode" 32)
 (setvar "EXPERT" 4)
 (setvar "DIMZIN" 0)
 (command "view" "s" "orig")
 (defun *error* (msg)
   (setvar "osmode" old_osmode)
   (setvar "clayer" old_clayer)
   (setvar "DIMZIN" old_DIMZIN)
   (setvar "EXPERT" old_EXPERT)
   (setvar "CECOLOR" oldcol)
   (command "view" "s" "orig")
   (if    (tblsearch "view" "orig")
     (progn
   (command "view" "r" "orig")
   (command "view" "d" "orig")
     )
   )
   (setvar "ucsview" old_ucsview)
   (setvar "cmdecho" old_cmdecho)
   (if
     (/= "function cancelled" msg)
      (if
    (= msg "quit / exit abort")
     (princ)
     (princ (strcat "\nerror: " msg))
      )
      (princ)
   )
   (setq *error* old_error)
   (princ)
 )
 (if
   (= 1 (logand 1 (getvar "undoctl")))
    (progn
      (command "._undo" "group")
      (setq intors t)
    )
    (set intors nil)
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (setq plan_ref (getreal "\nWhat Bench mark have Pl.ref: "))

 (setq pct_0 (getpoint "\nSelect one point on the reference line: "))
 
 (if (setq ss (ssget '((0 . "*POLY*"))))
   (progn
     (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
     (setq idx -1)
     (while (< (setq idx (1+ idx))(sslength ss))
   (setq ent (ssname ss idx))
   (setq totparam (fix (vlax-curve-getendparam ent))
         i -1
         r (getvar "circlerad"))
   (if (= r 0.0)
     (setq r 1.5)
     )
   (while (< (setq i (1+ i)) totparam)
     (setq pt (vlax-curve-getpointatparam ent i))

(setq Dy (/ (- (cadr pt) (cadr pct_0)) 10.0 ) )
(command "insert" "C:\\WBLOCK\\COTAL1.DWG" (polar pt 0.0 0.0) 10 10 0 (rtos (+ plan_ref Dy) 2 2))

     
     )
   (setq pt (vlax-curve-getpointatparam ent (vlax-curve-getendparam ent)))

(setq Dy (/ (- (cadr pt) (cadr pct_0)) 10.0 ) )
(command "insert" "C:\\WBLOCK\\COTAL1.DWG" (polar pt 0.0 0.0) 10 10 0 (rtos (+ plan_ref Dy) 2 2))

   )
     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
     )
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (if
   intors
    (progn
      (command ".undo" "_end")
      (setq intors nil)
    )
 )

 (setvar "osmode" old_osmode)
 (setvar "clayer" old_clayer)
 (setvar "ucsview" old_ucsview)
 (setvar "EXPERT" old_EXPERT)
 (setvar "CECOLOR" oldcol)
 (setVAR "dimzin" old_dimzin)
 (setvar "cmdecho" old_cmdecho)
 (gc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (princ)
 )

Cote_scurgere_ape v1.4.LSP

There is nobody here who can help me?

There is nobody here who can help me?

Problem is on you calculated points by distance along polyline

but you need to calculate them along X axis

Here is a quick and dirty code (without math)

(princ "\n***Type CS***")
(vl-load-com)
(defun c:CS (/ acsp adoc cnt dy ent ep intors obj oldcol old_clayer
     old_cmdecho old_dimzin old_error old_expert old_osmode
     old_ucsview p1 p2 pct_0 plan_ref pt sset sp ss xdelta xdist
     xend xline xstart yzero)
 (setq old_cmdecho (getvar "cmdecho"))
 (setq old_osmode (getvar "OSMODE"))
 (setq old_clayer (getvar "clayer"))
 (setq old_ucsview (getvar "ucsview"))
 (setq old_dimzin (getvar "dimzin"))
 (setq old_EXPERT (getvar "EXPERT"))
 (setq oldcol (getvar "CECOLOR"))
 (setq old_error *error*)
 (setvar "cmdecho" 0)
 (setvar "UCSVIEW" 1)
 (setvar "osmode" 32)
 (setvar "EXPERT" 4)
 (setvar "DIMZIN" 0)
 (command "view" "s" "orig")
 (defun *error* (msg)
   (setvar "osmode" old_osmode)
   (setvar "clayer" old_clayer)
   (setvar "DIMZIN" old_DIMZIN)
   (setvar "EXPERT" old_EXPERT)
   (setvar "CECOLOR" oldcol)
   (command "view" "s" "orig")
   (if (tblsearch "view" "orig")
     (progn
(command "view" "r" "orig")
(command "view" "d" "orig")
     )
   )

   (setvar "ucsview" old_ucsview)
   (setvar "cmdecho" old_cmdecho)
   (if
     (/= "function cancelled" msg)
      (if
 (= msg "quit / exit abort")
  (princ)
  (princ (strcat "\nerror: " msg))
      )
      (princ)
   )
   (setq *error* old_error)
   (princ)
 )
 (if
   (= 1 (logand 1 (getvar "undoctl")))
    (progn
      (command "._undo" "group")
      (setq intors t)
    )
    (set intors nil)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq plan_ref (getreal "\nWhat Bench mark have Pl.ref: "))
 (setq pct_0 (getpoint "\nSelect one point on the reference line: ")
yzero (cadr pct_0)
)
 (princ "\n >>  Select polyline  >>")
 (if (setq ss (ssget "+.:S:E" '((0 . "*POLY*"))))
   (progn
     (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))

      (if (not (tblsearch "layer" "Defpoints"))
    (command "._-layer" "_M" "Defpoints" "_S" "" "")
  )

     (setq acsp (vla-get-modelspace adoc))
     (setq ent (ssname ss 0))
     (setq obj (vlax-ename->vla-object ent))
     (setq sp (vlax-curve-getstartpoint obj)
    ep (vlax-curve-getendpoint obj)
    xstart (car sp)
    xend (car ep)
    xdelta (- xend xstart)
    )
     (setq xdist 0 cnt -1)
     (while (< xdist xdelta)
(setq cnt (1+ cnt)
      p1 (list (+ xstart (* 20. cnt)) yzero 0)
      p2 (list (car p1) (+ yzero 1000.0) 0)
      )
(setq xline (vla-addxline acsp (vlax-3d-point p1) (vlax-3d-point p2)))
(vlax-put xline 'Layer "Defpoints")
(setq pt (vlax-invoke xline 'IntersectWith obj 0))
       (setq Dy (/ (- (cadr pt) (cadr pct_0)) 10.0 ) )
(command "._-insert" (strcat (getvar "dwgprefix")"COTAL1.DWG") "_non" pt 0.01 0.01 0 (rtos (+ plan_ref Dy) 2 2))
(setq xdist (+ xdist 20))
)
(command "._-insert" (strcat (getvar "dwgprefix")"COTAL1.DWG") "_non" ep 0.01 0.01 0 (rtos (+ plan_ref Dy) 2 2))
(setq sset (ssget "X" (list (cons 0 "XLINE")(cons 8 "Defpoints")(cons 410 (getvar "CTAB")))))
     (if sset (command "._erase" sset ""))
     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
     )
   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (if
   intors
    (progn
      (command ".undo" "_end")
      (setq intors nil)
    )
 )
 (setvar "osmode" old_osmode)
 (setvar "clayer" old_clayer)
 (setvar "ucsview" old_ucsview)
 (setvar "EXPERT" old_EXPERT)
 (setvar "CECOLOR" oldcol)
 (setVAR "dimzin" old_dimzin)
 (setvar "cmdecho" old_cmdecho)
 (gc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (princ)
 )

~'J'~

Tank you for your reply,

I tried your code and gives me an error and draws xline only at the first point.

The error is:

********************

Command: CS

What Bench mark have Pl.ref: 268

Select one point on the reference line:

>> Select polyline >>

Select objects:

error: AutoCAD.Application: Key not found

********************

I followed the code and it seems ok, do not know where is the problem .

Tank you for your reply,

 

I tried your code and gives me an error and draws xline only at the first point.

The error is:

 

********************

 

Command: CS

What Bench mark have Pl.ref: 268

Select one point on the reference line:

>> Select polyline >>

Select objects:

error: AutoCAD.Application: Key not found

 

********************

 

I followed the code and it seems ok, do not know where is the problem .

Sorry my bad

The reason is on that layer "Defpoints" does not exist

Try edited code above

~'J'~

Tank you very much,

Now it's work fine, and is exactly what I wanted.

Tank you very much,

 

Now it's work fine, and is exactly what I wanted.

You're quite welcome

Cheers

~'J'~