add on vertex block or line

HI,
could you help me,
I need lisp or something else you consider is better:
I have polylines - not closed and I want to add to all vertex
on polyline object (block or line), which is perpendicular to
polyline.
Katarina

 

Katarina

Try this:

(defun C:MarkVertices ( / CurEnt CurObj ExLoop)
(vl-load-com)
(while (not ExLoop)
(initget " ")
(setq CurEnt (entsel "\nSelect Polyline: "))
(cond
((eq CurEnt "") (setq ExLoop T))
(CurEnt
(setq CurObj (vlax-ename->vla-object (car CurEnt)))
(if (eq (vla-get-ObjectName CurObj) "AcDbPolyline")
(setq ExLoop T)
(princ (strcat "selected entity is not a Polyline. "))
)
)
((princ "1 selected, 0 found. "))
)
)
(if CurObj (InsertAtVertex CurObj "MyBlock")) ;"MyBlock.dwg" if ext. Block
(princ)
)

(defun InsertAtVertex (Obj Nme / ActDoc CurSpc CurPar InsAng PntLst TmpLst)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
CurSpc (if (or
(= (getvar "TILEMODE") 1)
(> (getvar "CVPORT") 1)
)
(vla-get-ModelSpace ActDoc)
(vla-get-PaperSpace ActDoc)
)
TmpLst (vlax-get Obj "Coordinates")
)
(while
(setq PntLst (cons
(list (car TmpLst) (cadr TmpLst) 0.0)
PntLst
)
TmpLst (cddr TmpLst)
)
)
(foreach Pnt (reverse PntLst)
(setq CurPar (vlax-curve-getParamAtPoint Obj Pnt)
InsAng (Vec2Ang (vlax-curve-getFirstDeriv Obj CurPar))
)
(vla-InsertBlock CurSpc (vlax-3d-point Pnt) Nme 1 1 1 InsAng)
)
)
;
; == Function WvpVec2Ang
; Converts a vector to an angle.
; Arguments [Type]:
; Vec = Vector value

• 
  ; Return [Type]:
  ; > Angle value [REAL]
  ; Notes:
  ; Credits to Luis Esquivel
  ;
  (defun Vec2Ang (Vec / XvcVal YvcVal)
  (setq XvcVal (car Vec)
  YvcVal (cadr Vec)
  )
  (cond
  ((equal XvcVal 0 1E-4) (if (minusp YvcVal) (* pi 1.5) Wvi2))
  ((equal XvcVal -1 1E-4) pi)
  ((equal YvcVal 0 1E-4) (if (minusp XvcVal) pi 0))
  (T (atan (/ YvcVal XvcVal)))
  )
  )
  
  Cheers

 

Oops...

Line:
((eq CurEnt "") (setq ExLoop T))
must be:
((eq CurEnt "") (setq ExLoop T CurObj nil))

Cheers

 

Jurg:

Excuse my ignorance.

What is the Wvi2 in (if (minusp YvcVal) Wvi2)??

Bill

 

Bill

A constant in my application environment...
(/ pi 2)

Thanks for pointing to my sloppy work...

Cheers

 

Hi Katarina

Bill has found another mistake in my sample. Ok, third post:

(defun C:MarkVertices ( / CurEnt CurObj ExLoop)
(vl-load-com)
(while (not ExLoop)
(initget " ")
(setq CurEnt (entsel "\nSelect Polyline: "))
(cond
((eq CurEnt "") (setq ExLoop T CurObj nil))
(CurEnt
(setq CurObj (vlax-ename->vla-object (car CurEnt)))
(if (eq (vla-get-ObjectName CurObj) "AcDbPolyline")
(setq ExLoop T)
(princ (strcat "selected entity is not a Polyline. "))
)
)
((princ "1 selected, 0 found. "))
)
)
(if CurObj
(InsertAtVertex CurObj "MyBlock") ;"MyBlock.dwg" if ext. Block
)
(princ)
)

(defun InsertAtVertex (Obj Nme / ActDoc CurSpc CurPar InsAng PntLst TmpLst)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
CurSpc (if (or
(= (getvar "TILEMODE") 1)
(> (getvar "CVPORT") 1)
)
(vla-get-ModelSpace ActDoc)
(vla-get-PaperSpace ActDoc)
)
TmpLst (vlax-get Obj "Coordinates")
)
(while
(setq PntLst (cons
(list (car TmpLst) (cadr TmpLst) 0.0)
PntLst
)
TmpLst (cddr TmpLst)
)
)
(foreach Pnt (reverse PntLst)
(setq CurPar (vlax-curve-getParamAtPoint Obj Pnt)
InsAng (Vec2Ang (vlax-curve-getFirstDeriv Obj CurPar))
)
(vla-InsertBlock CurSpc (vlax-3d-point Pnt) Nme 1 1 1 InsAng)
)
)
;
; == Function Vec2Ang
; Converts a vector to an angle.
; Arguments [Type]:
; Vec = Vector value

• 
  ; Return [Type]:
  ; > Angle value [REAL]
  ; Notes:
  ; Credits to Luis Esquivel
  ;
  (defun Vec2Ang (Vec / XvcVal YvcVal)
  (setq XvcVal (car Vec)
  YvcVal (cadr Vec)
  )
  (cond
  ((equal XvcVal 0 1E-4) (if (minusp YvcVal) (* pi 1.5) (* pi 0.5)))
  ((equal XvcVal -1 1E-4) pi)
  ((equal YvcVal 0 1E-4) (if (minusp XvcVal) pi 0))
  (T (atan (/ YvcVal XvcVal)))
  )
  )
  
  Cheers

 

Jurg,

That's okay as I'm looking to use this for something that I need here.

Also: (T (atan (/ YvcVal XvcVal)))

Does not work in all situations.

(T (atan YvcVal XvcVal))
Works perfectly as it delivers the minus figure, when it should.

Bill

 

Thanx Bill...

Cheers

 

Hi,
Thank you for all,
I will try it.
Katarina

 

Hi,
it is working very good.
Thank you again
Katarina

 

Hi Katarina

Glad to help you...

Cheers