[编程交流] 帮我处理我的脏代码

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

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

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