[编程交流] Autolisp坡度

(defun c:lp (/ ptoy dist altu perc)
(setq ptox (getpoint "\nClick first point: "))
(setq ptoy (getpoint "\nClick second point: "))
(setq dist (rtos (distance ptox ptoy) 2 2))
(setq altu (- (cadr ptoy) (cadr ptox)))
(setq perc (rtos (* (/ altu (atof dist)) 100) 2 2))
(princ (strcat "Distance = " dist " ; Perc = " perc "%"))
(princ)
);defun 

(defun c:lp2 (/ _sel val b1 b2 f pt e_ diff distB)
(defun _addComma (str sp / a b m i lst)
   (if (numberp (read str))
     (progn
       (setq a   (vl-filename-base str)
             b   (substr str (1+ (strlen a)))
             m   (vl-string->list a)
             i   (length m)
             lst nil
       )
       (while (>= i 3)
         (setq lst (append (list sp
                                 (nth (- i 3) m)
                                 (nth (- i 2) m)
                                 (nth (1- i) m)
                           )
                           lst
                   )
               i   (- i 3)
         )
         lst
       )
       (strcat (substr str 1 i)
               (vl-list->string
                 (if (zerop i)
                   (cdr lst)
                   lst
                 )
               )
;;;    mod    
               (if b (vl-string-subst "," "." b) "")
;;    mod    
       )
     )
   )
 )      
(Defun _sel (msg / sel)
(princ (Strcat "\n<<Select " msg " Data>>"))
(While (null sel)
 (setq sel (ssget "_:S" '((0 . "INSERT")(2 . "SIMB_BOLINHA")))))
 (ssname sel 0))
(if
 (And (setq val nil
            b1  (_sel "First")
            b2  (_sel "Second")
      )
      (foreach e (list b1 b2)
        (setq f  nil
              pt (cdr (Assoc 10 (entget e)))
        )
        (if (and
              (while
                (and
                  (null f)
                  (eq (cdr (assoc 0 (setq e_ (entget (setq e (entnext e))))))
                      "ATTRIB"
                  )
                )
                 (if (eq "COTA" (strcase (cdr (assoc 2 e_))))
                   (Setq f (cdr (Assoc 1 e_)))
                 )
              )
              [b](progn
              (While (vl-string-position 46 f)
                            (setq f (vl-string-subst  "" "." f)))
              (setq f (distof (vl-string-subst "." "," f)))
              (numberp f))
            )[/b]
          (setq val (cons (list f pt) val)
          )
        )
      )
      (vl-every '(lambda ( x ) x )(apply 'append val))
      (= (length val) 2)
 )
  (alert (Strcat "\nSlope: " (rtos (* (/ (setq diff (abs (- (Caar val) (caadr val))))
                             (setq distB (distance (cadar val) (cadadr val)))
                          )
                          100.00
                       )
                       2
                       2
                 )
                 "%" " \nDifference of Elevation: "[b] (_addComma (rtos diff 2 2) 46)[/b]
                     " \nDistance between BLocks: "[b] (_addComma (rtos distB 2 2) 46)[/b]
         )
  )(princ "\n<<<Missing Information, Check Attribute Value>>>:")
 )
  (princ)
)

(setq sel (ssget "_:S" '((0 . "INSERT")(2 . [b][color="blue"]"SIMB_BOLINHA,SIMB_PONTO,SIMB_CRUZETA"[/color][/b]))))

(setq sel (ssget "_:S" '((0 . "INSERT")(2 . "SIMB_BOLINHA[color="red"],[/color]SIMB_PONTO[color="red"],[/color]SIMB_CRUZETA"))))