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

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