FUNCTION TO PLACE BLOCKS AT ENDPOINTS

[Scooby]

This lisp put point at endpoints. I'd like to change, put a specific block at endpoints.
Can somebody help me??

(princ "tDigite pontos p/ara iniciar ")
(defun contos ()
(setvar"cmdecho" 0)
;(command "osmode" 0)
(command "angbase" 270)
(command "angdir" 1)
(setq flagv "falso")
(setq controle 0)
(setq controle1 0)
(setq contador 0)
(while (= flagv "falso")
(setq mostre (entsel "\nMostre a Polyline <2d> : "))
(setq linha (entget (car mostre )))
(setq verificador (cdr(assoc 0 linha)))
(if (= verificador "LWPOLYLINE")
(progn
(setq verif (cdr (assoc 70 linha)))
(setq flagv "verdade")
)
(princ "tNão é Polyline !! ")
)
)

(setq controle1 (length linha))
(setq amostra '())
(repeat controle1
(setq x (caar linha))
(if (= x 10)
(progn
(setq item (car linha))
(setq amostra (cons item amostra))
(setq contador (1+ contador))
)
)
(setq linha (cdr linha))
)
(setq amostra1 (reverse amostra))
(if (= verif 1)
(setq amostra (cons (car amostra1) amostra))
(setq contador (1- contador))
)
(setq controle contador)
(repeat controle
(setq PTO1 (cdr(car amostra)))
(setq PTO2 (cdr(car(cdr amostra))))
(AZIMUTAR)
(setq amostra(cdr amostra))
)
(princ)
)
(defun AZIMUTAR ()
(setq padroes (getvar "osmode"))
(setvar"cmdecho" 0)
(command "osmode" 0)
(setq A PTO1)
(setq B PTO2)
;;(setq C " - Az ")
;;(setq D (angtos (angle A B) 1 4))
;;(MUDAR)
;;(setq E (rtos (distance A B) 2 4))
;;(setq DADO (strcat E C PALAV))
;;(PARALELO)
;;(command "text" "j" "mc" ponto_meio 2.5 inicio dado )
;;(command "osmode" padroes)
(setq angulo (angle A B))
(setq ang2 (+ angulo (dtr 90)))
(princ angulo)
(princ ang2)
(entmake
(list (cons 0 "point")
(cons 10 B)
)
)
)
(defun PARALELO ()
(setq A1 (polar A (+ (/ pi 2)(angle B A )) 2))
(setq B1 (polar B (+ (/ pi 2)(angle B A )) 2))
(setq ptx (/ (+ (car B1) (car A1)) 2))
(setq pty (/ (+ (cadr B1) (cadr A1)) 2))
(setq ponto_meio (list ptx pty))
(if (< (car A1)(car B1))
(setq inicio B1)
(setq inicio A1)
)
)
(defun MUDAR ()
(setq XL 2)
(setq J "d")
(setq COM1 (substr D 1 1))
(while (< XL 5)
(setq LETRAT (substr D XL 1))
(setq RESTOT (substr D (+ 1 XL) ))
(if (= LETRAT J)
(progn (setq J "%%d")
(setq XL 6)
(setq PALAV (strcat COM1 J RESTOT))
)
)
(setq COM1 (strcat COM1 LETRAT ))
(setq XL (1+ XL))
)
)
(defun RTD ()
(/ (* (angle A B) 180) Pi)
)
(defun DTR (AZIMUTE)
(* (/ AZIMUTE 180.0) pi) ;; esta linha também foi alterada
)

Best Regards

[Scooby]

Much easier to read.

 (princ "tDigite pontos p/ara iniciar ") 
(defun contos () 
(setvar"cmdecho" 0) 
;(command "osmode" 0) 
(command "angbase" 270) 
(command "angdir" 1) 
(setq flagv "falso") 
(setq controle 0) 
(setq controle1 0) 
(setq contador 0) 
(while (= flagv "falso")
 (setq mostre (entsel "\nMostre a Polyline <2d> : ")) 
(setq linha (entget (car mostre ))) 
(setq verificador (cdr(assoc 0 linha))) 
(if (= verificador "LWPOLYLINE") 
(progn 
(setq verif (cdr (assoc 70 linha))) 
(setq flagv "verdade") 
) 
(princ "tNão é Polyline !! ") 
) 
) 

(setq controle1 (length linha)) 
(setq amostra '()) 
(repeat controle1 
(setq x (caar linha)) 
(if (= x 10) 
(progn 
(setq item (car linha)) 
(setq amostra (cons item amostra)) 
(setq contador (1+ contador)) 
) 
) 
(setq linha (cdr linha)) 
) 
(setq amostra1 (reverse amostra)) 
(if (= verif 1) 
(setq amostra (cons (car amostra1) amostra)) 
(setq contador (1- contador)) 
) 
(setq controle contador) 
(repeat controle 
(setq PTO1 (cdr(car amostra))) 
(setq PTO2 (cdr(car(cdr amostra)))) 
(AZIMUTAR) 
(setq amostra(cdr amostra)) 
) 
(princ) 
) 
(defun AZIMUTAR () 
(setq padroes (getvar "osmode")) 
(setvar"cmdecho" 0) 
(command "osmode" 0) 
(setq A PTO1) 
(setq B PTO2) 
;;(setq C " - Az ") 
;;(setq D (angtos (angle A B) 1 4)) 
;;(MUDAR) 
;;(setq E (rtos (distance A B) 2 4)) 
;;(setq DADO (strcat E C PALAV)) 
;;(PARALELO) 
;;(command "text" "j" "mc" ponto_meio 2.5 inicio dado ) 
;;(command "osmode" padroes) 
(setq angulo (angle A B)) 
(setq ang2 (+ angulo (dtr 90))) 
(princ angulo) 
(princ ang2)
 (entmake
 (list (cons 0 "point")
 (cons 10 B)
 )
 )
 )
 (defun PARALELO () 
(setq A1 (polar A (+ (/ pi 2)(angle B A )) 2)) 
(setq B1 (polar B (+ (/ pi 2)(angle B A )) 2)) 
(setq ptx (/ (+ (car B1) (car A1)) 2)) 
(setq pty (/ (+ (cadr B1) (cadr A1)) 2)) 
(setq ponto_meio (list ptx pty)) 
(if (< (car A1)(car B1)) 
(setq inicio B1) 
(setq inicio A1) 
) 
) 
(defun MUDAR () 
(setq XL 2) 
(setq J "d") 
(setq COM1 (substr D 1 1)) 
(while (< XL 5) 
(setq LETRAT (substr D XL 1)) 
(setq RESTOT (substr D (+ 1 XL) )) 
(if (= LETRAT J) 
(progn (setq J "%%d") 
(setq XL 6) 
(setq PALAV (strcat COM1 J RESTOT)) 
) 
) 
(setq COM1 (strcat COM1 LETRAT )) 
(setq XL (1+ XL)) 
) 
) 
(defun RTD () 
(/ (* (angle A B) 180) Pi) 
) 
(defun DTR (AZIMUTE) 
(* (/ AZIMUTE 180.0) pi) ;; esta linha também foi alterada 
) (princ "tDigite pontos p/ara iniciar ") 
(defun contos () 
(setvar"cmdecho" 0) 
;(command "osmode" 0) 
(command "angbase" 270) 
(command "angdir" 1) 
(setq flagv "falso") 
(setq controle 0) 
(setq controle1 0) 
(setq contador 0) 
(while (= flagv "falso")
 (setq mostre (entsel "\nMostre a Polyline <2d> : ")) 
(setq linha (entget (car mostre ))) 
(setq verificador (cdr(assoc 0 linha))) 
(if (= verificador "LWPOLYLINE") 
(progn 
(setq verif (cdr (assoc 70 linha))) 
(setq flagv "verdade") 
) 
(princ "tNão é Polyline !! ") 
) 
) 

(setq controle1 (length linha)) 
(setq amostra '()) 
(repeat controle1 
(setq x (caar linha)) 
(if (= x 10) 
(progn 
(setq item (car linha)) 
(setq amostra (cons item amostra)) 
(setq contador (1+ contador)) 
) 
) 
(setq linha (cdr linha)) 
) 
(setq amostra1 (reverse amostra)) 
(if (= verif 1) 
(setq amostra (cons (car amostra1) amostra)) 
(setq contador (1- contador)) 
) 
(setq controle contador) 
(repeat controle 
(setq PTO1 (cdr(car amostra))) 
(setq PTO2 (cdr(car(cdr amostra)))) 
(AZIMUTAR) 
(setq amostra(cdr amostra)) 
) 
(princ) 
) 
(defun AZIMUTAR () 
(setq padroes (getvar "osmode")) 
(setvar"cmdecho" 0) 
(command "osmode" 0) 
(setq A PTO1) 
(setq B PTO2) 
;;(setq C " - Az ") 
;;(setq D (angtos (angle A B) 1 4)) 
;;(MUDAR) 
;;(setq E (rtos (distance A B) 2 4)) 
;;(setq DADO (strcat E C PALAV)) 
;;(PARALELO) 
;;(command "text" "j" "mc" ponto_meio 2.5 inicio dado ) 
;;(command "osmode" padroes) 
(setq angulo (angle A B)) 
(setq ang2 (+ angulo (dtr 90))) 
(princ angulo) 
(princ ang2)
 (entmake
 (list (cons 0 "point")
 (cons 10 B)
 )
 )
 )
 (defun PARALELO () 
(setq A1 (polar A (+ (/ pi 2)(angle B A )) 2)) 
(setq B1 (polar B (+ (/ pi 2)(angle B A )) 2)) 
(setq ptx (/ (+ (car B1) (car A1)) 2)) 
(setq pty (/ (+ (cadr B1) (cadr A1)) 2)) 
(setq ponto_meio (list ptx pty)) 
(if (< (car A1)(car B1)) 
(setq inicio B1) 
(setq inicio A1) 
) 
) 
(defun MUDAR () 
(setq XL 2) 
(setq J "d") 
(setq COM1 (substr D 1 1)) 
(while (< XL 5) 
(setq LETRAT (substr D XL 1)) 
(setq RESTOT (substr D (+ 1 XL) )) 
(if (= LETRAT J) 
(progn (setq J "%%d") 
(setq XL 6) 
(setq PALAV (strcat COM1 J RESTOT)) 
) 
) 
(setq COM1 (strcat COM1 LETRAT )) 
(setq XL (1+ XL)) 
) 
) 
(defun RTD () 
(/ (* (angle A B) 180) Pi) 
) 
(defun DTR (AZIMUTE) 
(* (/ AZIMUTE 180.0) pi) ;; esta linha também foi alterada 
)(princ "tDigite pontos p/ara iniciar ") 
(defun contos () 
(setvar"cmdecho" 0) 
;(command "osmode" 0) 
(command "angbase" 270) 
(command "angdir" 1) 
(setq flagv "falso") 
(setq controle 0) 
(setq controle1 0) 
(setq contador 0) 
(while (= flagv "falso")
 (setq mostre (entsel "\nMostre a Polyline <2d> : ")) 
(setq linha (entget (car mostre ))) 
(setq verificador (cdr(assoc 0 linha))) 
(if (= verificador "LWPOLYLINE") 
(progn 
(setq verif (cdr (assoc 70 linha))) 
(setq flagv "verdade") 
) 
(princ "tNão é Polyline !! ") 
) 
) 

(setq controle1 (length linha)) 
(setq amostra '()) 
(repeat controle1 
(setq x (caar linha)) 
(if (= x 10) 
(progn 
(setq item (car linha)) 
(setq amostra (cons item amostra)) 
(setq contador (1+ contador)) 
) 
) 
(setq linha (cdr linha)) 
) 
(setq amostra1 (reverse amostra)) 
(if (= verif 1) 
(setq amostra (cons (car amostra1) amostra)) 
(setq contador (1- contador)) 
) 
(setq controle contador) 
(repeat controle 
(setq PTO1 (cdr(car amostra))) 
(setq PTO2 (cdr(car(cdr amostra)))) 
(AZIMUTAR) 
(setq amostra(cdr amostra)) 
) 
(princ) 
) 
(defun AZIMUTAR () 
(setq padroes (getvar "osmode")) 
(setvar"cmdecho" 0) 
(command "osmode" 0) 
(setq A PTO1) 
(setq B PTO2) 
;;(setq C " - Az ") 
;;(setq D (angtos (angle A B) 1 4)) 
;;(MUDAR) 
;;(setq E (rtos (distance A B) 2 4)) 
;;(setq DADO (strcat E C PALAV)) 
;;(PARALELO) 
;;(command "text" "j" "mc" ponto_meio 2.5 inicio dado ) 
;;(command "osmode" padroes) 
(setq angulo (angle A B)) 
(setq ang2 (+ angulo (dtr 90))) 
(princ angulo) 
(princ ang2)
 (entmake
 (list (cons 0 "point")
 (cons 10 B)
 )
 )
 )
 (defun PARALELO () 
(setq A1 (polar A (+ (/ pi 2)(angle B A )) 2)) 
(setq B1 (polar B (+ (/ pi 2)(angle B A )) 2)) 
(setq ptx (/ (+ (car B1) (car A1)) 2)) 
(setq pty (/ (+ (cadr B1) (cadr A1)) 2)) 
(setq ponto_meio (list ptx pty)) 
(if (< (car A1)(car B1)) 
(setq inicio B1) 
(setq inicio A1) 
) 
) 
(defun MUDAR () 
(setq XL 2) 
(setq J "d") 
(setq COM1 (substr D 1 1)) 
(while (< XL 5) 
(setq LETRAT (substr D XL 1)) 
(setq RESTOT (substr D (+ 1 XL) )) 
(if (= LETRAT J) 
(progn (setq J "%%d") 
(setq XL 6) 
(setq PALAV (strcat COM1 J RESTOT)) 
) 
) 
(setq COM1 (strcat COM1 LETRAT )) 
(setq XL (1+ XL)) 
) 
) 
(defun RTD () 
(/ (* (angle A B) 180) Pi) 
) 
(defun DTR (AZIMUTE) 
(* (/ AZIMUTE 180.0) pi) ;; esta linha também foi alterada 
)

Greetings

[Scooby]

This programm put blocks at measured intervals.
I wanna put the blocks at endpoints.
Can somebody help me, please?

 ;; Function to place blocks at measured intervals 
(defun c:MeasureCSV (/ bname path dist ss n en ed fn f)
  ;; Ask user to select path, distance & block name
  (if (and (setq path (entsel "Select object to measure: ")) ;Check if user's picked an object
           (setq dist (getdist "Specify length of segment: ")) ;Check if user's specified distance
           (setq bname (getstring t "Enter name of block to insert: ")) ;Check if user's specified block name
           (tblsearch "BLOCK" bname) ;Check if block exists
      ) ;_ end of and
    (progn
      ;; Do the Measure command
      (command "_.MEASURE" path "_Block" bname "_Yes" dist)

      ;; Get a selection set of the blocks created
          (if (setq ss (ssget "P")) ;Select previous
            (progn
              (setq n 0) ;initialize counter
              (while (< n (sslength ss)) ;While counter is less than selection set's length
                (setq en (ssname ss n) ;Get the nth item from the selection set
                      ed (entget en) ;Get its DXF data list
                ) ;_ end of setq
                (write-line
                  (strcat (rtos (cadr (assoc 10 ed))) ;X value
                          ","
                          (rtos (caddr (assoc 10 ed))) ;Y value
                          ","
                          (rtos (cadddr (assoc 10 ed))) ;Z value
                  ) ;_ end of strcat
                  f
                ) ;_ end of write-line
                (setq n (1+ n)) ;Increment counter
              ) ;_ end of while
            ) ;_ end of progn
          ) ;_ end of if

          (close f) ;Close the file
        ) ;_ end of progn
        (princ "Stopped.")
      ) ;_ end of if
    ) ;_ end of progn
    (princ "*Invalid*") ;Else stop & show error
  ) ;_ end of if
  (princ) ;Don't show anything else on command line
) ;_ end of defun

Thanks in advance

[Scooby]

Opie, Tharwat, help me, please.

Kind Regards

[marko_ribar]

Doesn't checked - just used your example :

 ;; Function to place blocks at end intervals 
(vl-load-com) ; initialize vla functions
(defun c:EndsCSV (/ bname path dist ss n en ed fn f)
  ;; Ask user to select path, distance & block name
  (if (and (setq path (car (entsel "Select object to measure end points: "))) ;Check if user's picked an object
           (setq dist (- (vlax-curve-getdistatpoint (vlax-ename->vla-object path) (vlax-curve-getendpoint (vlax-ename->vla-object path))) (vlax-curve-getdistatpoint (vlax-ename->vla-object path) (vlax-curve-getstartpoint (vlax-ename->vla-object path))) )) ;Check if specified distance
           (setq bname (getstring t "Enter name of block to insert: ")) ;Check if user's specified block name
           (tblsearch "BLOCK" bname) ;Check if block exists
      ) ;_ end of and
    (progn
      ;; Do the Measure command
      (command "_.MEASURE" path "_Block" bname "_Yes" dist)

      ;; Get a selection set of the blocks created
          (if (setq ss (ssget "P")) ;Select previous
            (progn
              (setq n 0) ;initialize counter
              (while (< n (sslength ss)) ;While counter is less than selection set's length
                (setq en (ssname ss n) ;Get the nth item from the selection set
                      ed (entget en) ;Get its DXF data list
                ) ;_ end of setq
                (write-line
                  (strcat (rtos (cadr (assoc 10 ed))) ;X value
                          ","
                          (rtos (caddr (assoc 10 ed))) ;Y value
                          ","
                          (rtos (cadddr (assoc 10 ed))) ;Z value
                  ) ;_ end of strcat
                  f
                ) ;_ end of write-line
                (setq n (1+ n)) ;Increment counter
              ) ;_ end of while
            ) ;_ end of progn
          ) ;_ end of if

          (close f) ;Close the file
        ) ;_ end of progn
        (princ "Stopped.")
      ) ;_ end of if
    ) ;_ end of progn
    (princ "*Invalid*") ;Else stop & show error
  ) ;_ end of if
  (princ) ;Don't show anything else on command line
) ;_ end of defun

M.R.

[Scooby]

This program didn't put blocks in each endpoint of a polilyne.
But is similar that I need.

attached

[Scooby]

Attached File.
BLOCKS AT ENDPOINTS.dwg

Best Regards

[Opie]

You can try this. It will place a user selected block at each vertex of polylines only. This is fairly quick and dirty routine and could use some refinement which I do not have time to complete.

(defun c:PlaceEndBlocks	(/		_SaveSysVars   _RestoreSysVars
			 objTangent	objBlock       strBlock
			 lstPoints
			)
  (defun _SaveSysVars (sysvar value /)
    (if	O:SavedVariables
      (if (not (assoc sysvar O:SavedVariables))
	(setq O:SavedVariables
	       (append O:SavedVariables
		       (cons sysvar (getvar sysvar))
	       )
	)
      )
      (setq O:SavedVariables (list (cons sysvar (getvar sysvar))))
    )
    (setvar sysvar value)
  )
  (defun _RestoreSysVars ()
    (if	O:SavedVariables
      (progn
	(mapcar	'(lambda (x) (setvar (car x) (cdr x)))
		O:SavedVariables
	)
	(setq O:SavedVariables nil)
      )
    )
  )

  (if (and (setq objTangent (entsel "\nSelect line: "))
	   (wcmatch (cdr (assoc 0 (entget (car objTangent)))) "*POLY*")
	   (/= (cdr (assoc 0 (entget (car objTangent)))) "LINE")
	   (setq objTangent (vlax-ename->vla-object (car objTangent)))
	   (setq objBlock (entsel "\nSpecify block: "))
	   (setq strBlock
		  (vla-get-name
		    (setq objBlock (vlax-ename->vla-object (car objBlock)))
		  )
	   )
      )
    (progn
      (setq lstPoints (list (vlax-curve-getendpoint objTangent)))
      (repeat (fix (setq cnt (vlax-curve-getendparam objTangent)))
	(setq lstPoints	(append	lstPoints
				(list (vlax-curve-getpointatparam
					objTangent
					(fix (setq cnt (- cnt 1)))
				      )
				)
			)
	)
      )
      (if (vlax-get-property objBlock 'HasAttributes)
	(_SaveSysVars "attreq" 0)
      )
      (foreach n lstPoints
	(vl-cmdf "_.insert" strBlock "_non" n "1" "1" "0")
      )
      (_RestoreSysVars)
    )
    (prompt "\nConvert this object to a polyline and try again. ")
  )
  (princ)
)