Help me with my dirty code

Hey guys,

Happy New Years for everybody!

Best wishes for healthy and Prosperous New Year.

I need a help with my code. I'm trying to write a lisp that put elevation text through intersection of a selected polyline.

My english is too bad, so I've attached a file to explain better my task.

Any idea is very wellcome.

TEST.dwg

Sorry guys,

I forget to post my code.

(defun c:perfil()
(setq cota-base (getpoint "\nInforme um ponto para cota base :"))
(setq valor-cota (getreal "\nInforme a cota :"))
(setq mostre (entsel "\nSelecione a linha do projeto : "))
(setq bto (getpoint "\nInforme um ponto base para os textos :"))
 
;;;------------------------------------------------------------------------------------------------------------


(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 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)

 
;-------------------------------------------------------------------------------------------------------------------------------------

(setq x-bto (car bto)
     x-b (car b))
 (setq dist (- x-b x-bto))  
(setq p-proj (polar bto 0 dist))
 (setq p-proj (polar p-proj (/ pi 2) 0.1))
   (setq p-proj (polar p-proj 179 0.1))
 (setq cota (cadr cota-base)
   c-proj (cadr b))
 (setq cota-final (rtos(+(abs(- c-proj cota))valor-cota)2 3))
 (command "zoom" "o" mostre "")
(command "text" p-proj (/ pi 2) cota-final "")

;-------------------------------------------------------------------------------------------------------------------------------------
 
 
)
(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
   (setvar "osmode" 16383)
)

This routine put elevation in each endpoint of a project line. (the polyline selected)

I just need change the endpoint for intersection.

Can anybody help me, please?

Thank in advance.

Madruga_SP,

a different approach, but I hope that the result is what you want.

Attached is your dwg with some notes, to explain the use of the code.

(defun c:perfil (/  ss1  ss  itm  obj  ptlst
  ent1  obj1  int  osm_old ct_base base_obj
  lbtxt  txt_obj dist  pt_txt
 )
 (vl-load-com)
 (prompt "\nSelecione a Polyline do projeto : ")
 (if (setq ss1 (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
   (progn
     (prompt "\nSelecione as linhas verticais: ")
     (if (setq ss (ssget '((0 . "LINE"))))
(progn
  (setq itm   0
 obj   (vlax-ename->vla-object (ssname ss1 0))
 ptlst nil
  )
  (repeat (sslength ss)
    (setq ent1 (ssname ss itm)
   obj1 (vlax-ename->vla-object ent1)
    )
    (if (setq int (vla-IntersectWith obj obj1 acExtendNone))
      (progn
 (setq int   (vlax-safearray->list (vlax-variant-value int))
       ptlst (append ptlst (list int))
 )
      )
      ;; progn
    )
    ;; If
    (setq itm (1+ itm))
  )
  (setq osm_old (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq ct_base (entsel "\nSelecione a linha da cota base :"))
  (setq base_obj (vlax-ename->vla-object (car ct_base)))
  (setq ref
  (atof
    (cdr
      (assoc
        1
        (entget
   (car
     (entsel "\nSelecione o texto da cota base :")
   )
        )
      )
    )
  )
  )
  (setq
    lbtxt (entsel "\nSelecione a linha base para os textos :")
  )
  (setq txt_obj (vlax-ename->vla-object (car lbtxt)))
  (foreach n ptlst
    (setq dist (vlax-curve-getClosestPointTo base_obj n T))
    (setq dist (+ (distance n dist) ref))
    (setq pt_txt (vlax-curve-getClosestPointTo txt_obj n))
    (setq pt_txt (polar pt_txt (* (/ pi 4) 3) 0.1))
    (command "TEXT" pt_txt 0. (rtos dist 2 3))
  )
  ;; foreach
)
;; progn
     )
     ;; if
   )
   ;; progn
 )
 ;; if
 (setvar "OSMODE" osm_old)
 (princ)
)

hope that helps

Henrique

TEST_1.dwg

Hi Henrinque,

Thanks for the quick replay.

Excellent lisp routine!

Thank you very much, I really appreciate your help.

Regards.

You're welcome, Madruga_SP

Henrique

Henrique,

May I ask you to modify just one more thing the code?

Because I need add two information: cota do coletor e profundidade do coletor.

Best Regards

e.g

Lisp Perfil.dwg

Madruga_SP,

Attached is a sample dwg,

I think that the code does what you need.

(defun c:perfil (/   ss1    ss     itm      obj      osm_old
  angb_old angd_old ct_base  base_obj ref      lbtxt
  pt1   pt2    pt3     ent1     obj1     ss
  itm   ptint    lent     txt_obj  ptdist   grade
  pt_txt   pt_txt1  pt_txt2
 )
 (vl-load-com)
 (prompt "\nSelecione a Polyline do Grade : ")
 (if (setq ss1 (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
   (progn
     (prompt "\nSelecione as linhas verticais do Coletor: ")
     (if (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
(progn
  (setq itm  0
 obj  (vlax-ename->vla-object (ssname ss1 0))
 osm_old  (getvar "OSMODE")
 angb_old (getvar "ANGBASE")
 angd_old (getvar "ANGDIR")
  )
  (setvar "OSMODE" 0)
  (setvar "ANGBASE" (/ PI 2.))
  (setvar "ANGDIR" 1)
  (setq ct_base  (entsel "\nSelecione a linha da cota base :")
 base_obj (vlax-ename->vla-object (car ct_base))
 ref  (atof
     (cdr
       (assoc
         1
         (entget
    (car
      (entsel "\nSelecione o texto da cota base :")
    )
         )
       )
     )
   )
  )
  (setvar "OSMODE" 512)
  (prompt
    "\nSelecione a linha base para os textos cota do grade:"
  )
  (setq lbtxt
  (nentselp
    "\nSelecione a linha base para os textos cota do grade:"
    (setq pt1 (getpoint))
  )
  )
  (setvar "OSMODE" 128)
  (setq pt2   (getpoint
  pt1
  "\nSelecione a linha base para os textos cota do coletor:"
       )
 pt3   (getpoint
  pt1
  "\nSelecione a linha base para os textos profundidade do coletor:"
       )
 dist1 (distance pt1 pt2)
 dist2 (distance pt1 pt3)
  )
  (repeat (sslength ss)
    (setq ent1 (ssname ss itm)
   obj1 (vlax-ename->vla-object ent1)
    )
    (if (setq ptint (vla-IntersectWith obj obj1 acExtendNone))
      (progn
 (setq lent    (vla-get-length obj1)
       txt_obj (vlax-ename->vla-object (car lbtxt))
       ptint   (vlax-safearray->list
   (vlax-variant-value ptint)
        )
       ptdist  (vlax-curve-getClosestPointTo base_obj ptint T)
       grade   (+ (distance ptint ptdist) ref)
       pt_txt  (vlax-curve-getClosestPointTo txt_obj ptint)
       pt_txt  (polar pt_txt (* (/ pi 4) 3) 0.15)
 )
 (command "TEXT" pt_txt 0. (rtos grade 2 3))
 (setq pt_txt1 (polar pt_txt (angle pt1 pt2) dist1))
 (command "TEXT" pt_txt1 0. (rtos (- grade lent) 2 3))
 (setq pt_txt2 (polar pt_txt (angle pt1 pt3) dist2))
 (command "TEXT" pt_txt2 0. (rtos lent 2 3))
      )
      ;; progn
    )
    ;; If
    (setq itm (1+ itm))
  )
  ;; repeat
)
;; progn
     )
     ;; if
   )
   ;; progn
 )
 ;; if
 (setvar "OSMODE" osm_old)
 (setvar "ANGBASE" angb_old)
 (setvar "ANGDIR" angd_old)
 (princ)
)

hope that helps

Henrique

Lisp Perfil-2.dwg

Hi Henrique,

Thanks again. Your code is amazing!

It's exactly I was looking in ages. I really appreciate your great help and the good explanation how to use the code.

But you the text isn't position properly. Maybe I'm doing something wrong.

Could you please help me find my mistake, please?

Thanks again, my friend.

Muito obrigado, meu amigo.

Lisp Perfil-3.dwg

Madruga_SP,

I already see the error,

I'm now in the middle of another project,

but I'll fix sooner,

Henrique

Thank you very much, Henrique!

Madruga_SP,

I think it is already fixed,

minimally tested.

(defun c:perfil (/   ss1    ss     itm      obj      osm_old
  angb_old angd_old ct_base  base_obj ref      lbtxt
  pt1   pt2    pt3     ent1     obj1     dist1
  dist2   base_obj itm     ptint    lent     txt_obj
  ptdist   grade    pt_txt   pt_txt1  pt_txt2
 )
 (vl-load-com)
 (prompt "\nSelecione a Polyline do Grade : ")
 (if (setq ss1 (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
   (progn
     (prompt "\nSelecione as linhas verticais do Coletor: ")
     (if (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
(progn
  (setq itm  0
 obj  (vlax-ename->vla-object (ssname ss1 0))
 osm_old  (getvar "OSMODE")
 angb_old (getvar "ANGBASE")
 angd_old (getvar "ANGDIR")
  )
  (setvar "OSMODE" 0)
  (setvar "ANGBASE" (/ PI 2.))
  (setvar "ANGDIR" 1)
  (setq ct_base  (entsel "\nSelecione a linha da cota base :")
 base_obj (vlax-ename->vla-object (car ct_base))
 ref  (atof
     (cdr
       (assoc
         1
         (entget
    (car
      (entsel "\nSelecione o texto da cota base :")
    )
         )
       )
     )
   )
  )
  (setvar "OSMODE" 512)
  (setq lbtxt
  (nentselp
    "\nSelecione a linha base para os textos cota do grade:"
  )
  )
  (setvar "OSMODE" 128)
  (setq pt1 (cadr lbtxt)
 txt_obj (vlax-ename->vla-object (car lbtxt))
 pt1 (vlax-curve-getClosestPointTo txt_obj pt1 T)
  )
  (setq pt2   (getpoint
  pt1
  "\nSelecione a linha base para os textos cota do coletor:"
       )
 pt3   (getpoint
  pt1
  "\nSelecione a linha base para os textos profundidade do coletor:"
       )
 dist1 (distance pt1 pt2)
 dist2 (distance pt1 pt3)
  )
  (setvar "OSMODE" 0)
  (repeat (sslength ss)
    (setq ent1 (ssname ss itm)
   obj1 (vlax-ename->vla-object ent1)
    )
    (if (setq ptint (vla-IntersectWith obj obj1 acExtendNone))
      (progn
 (setq lent   (vla-get-length obj1)
       ptint  (vlax-safearray->list
         (vlax-variant-value ptint)
       )
       ptdist (vlax-curve-getClosestPointTo base_obj ptint T)
       grade  (+ (distance ptint ptdist) ref)
       pt_txt (vlax-curve-getClosestPointTo txt_obj ptint)
       pt_txt (polar pt_txt (* (/ pi 4) 3) 0.15)
 )
 (command "TEXT" pt_txt 0. (rtos grade 2 3))
 (setq pt_txt1 (polar pt_txt (angle pt1 pt2) dist1))
 (command "TEXT" pt_txt1 0. (rtos (- grade lent) 2 3))
 (setq pt_txt2 (polar pt_txt (angle pt1 pt3) dist2))
 (command "TEXT" pt_txt2 0. (rtos lent 2 3))
      )
      ;; progn
    )
    ;; If
    (setq itm (1+ itm))
  )
  ;; repeat
)
;; progn
     )
     ;; if
   )
   ;; progn
 )
 ;; if
 (setvar "OSMODE" osm_old)
 (setvar "ANGBASE" angb_old)
 (setvar "ANGDIR" angd_old)
 (princ)
)

Cheers

Henrique

:notworthy:

Thank you very much, Henrique.

You're awesome!!

Worked like a charm!

Regards

You're welcome, Madruga_SP

Cheers

Henrique