获取当前CAD文档的比例尺列表并排序

guosheyang · 发表于 2023-12-8 10:19:07

本帖最后由 guosheyang 于 2023-12-8 10:29 编辑

   给大家分享一个收集整理的函数-----获取当前CAD文档的比例尺列表并排序，有问题请反馈，谢谢！
; ygs--羊羊羊搜集整理  2023年12月8日
;执行 (getscaleList)

;;;------------------------------------------------------------------------------------------------------------
;;  SortList di Gile & LeeMac
;;; uso:
;;;(setq L_SCA (list "1:200" "1:1" "1:500" "1:5" "2:1" "Adatta" "1:20" "1:5000" ))
;;;(ArchSort L_SCA)
;;;------------------------------------------------------------------------------------------------------------
;; ? ArchSort ?  (Gile)                ;;
;; ~ Sorts a list of strings by numerical ;;
;; values, then by Prefix/Suffix.    ;;
;;;------------------------------------------------------------------------------------------------------------
(defun ArchSort (lst / comparable)

  (defun comparable (e1 e2)

(or (and (numberp e1) (numberp e2))

      (= 'STR (type e1) (type e2))

      (not e1)

      (not e2)))

  (mapcar

(function

   (lambda (x)

      (nth x lst)))

(vl-sort-i (mapcar 'SplitStr lst)

   (function

      (lambda (x1 x2 / n1 n2 comp)

      (while

         (and (setq comp (comparable (setq n1 (car x1))

                                    (setq n2 (car x2))))

               (= n1 n2))

         (setq x1 (cdr x1) x2 (cdr x2)))

      (if comp (< n1 n2) (numberp n1))))))

)

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

;; ? SplitStr ?  (Gile)                      ;;

;; ~ Breaks a string into a list of Numbers ;;

;; and/or strings.                         ;;

(defun SplitStr       (str / lst test rslt num tmp)

  (setq       lst  (vl-string->list str)

      test (chr (car lst)))

  (if (< 47 (car lst) 58)

(setq num T))

  (while (setq lst (cdr lst))

(if       num

   (cond (  (= 46 (car lst))

            (if (and (cadr lst)

                     (setq tmp (strcat "0." (chr (cadr lst))))

                     (numberp (read tmp)))

               (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))

               (setq rslt (cons (read test) rslt) test "." num nil)))

         (  (< 47 (car lst) 58)

            (setq test (strcat test (chr (car lst)))))

         (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))

   (if (< 47 (car lst) 58)

      (setq rslt (cons test rslt) test (chr (car lst)) num  T)

      (setq test (strcat test (chr (car lst)))))))

  (if num

(setq rslt (cons (read test) rslt))

(setq rslt (cons test rslt)))

  (reverse rslt)

)

;(getscaleList)

(defun getscaleList( / N NLIST SCALELIST SCALELISTENTS)

;获取当前CAD文档的比例尺列表并排序

(setq scalelist

(mapcar'(lambda(x)

  (cdr(assoc 300(entget x))))

  (mapcar 'cdr

(vl-remove-if-not

'(lambda (item) (eq (car item) 350))

(dictsearch (namedobjdict) "ACAD_SCALELIST")

  )

  )

)

)

(archsort (vl-remove "" scalelist))

)

yefei812678 · 发表于 2024-4-21 09:58:49

感谢分享感谢分享感谢分享感谢分享

a405692168 · 发表于 2023-12-10 17:31:35

感谢楼主分享

KO你 · 发表于 2023-12-12 15:16:01

谢谢分享，看看有什么不同

zxh92 · 发表于 2023-12-8 11:19:29

11111111111111111

不一样地设计 · 发表于 2023-12-8 11:23:34

感谢楼主分享

ptime · 发表于 2023-12-8 12:37:27

谢谢分享！！！

lxl217114 · 发表于 2023-12-8 15:58:48

谢谢大佬分享

丶俗人 · 发表于 2023-12-8 17:58:21

好奇的看看,谢谢

photo_cup · 发表于 2023-12-8 20:01:19

KANKAN ..........

Dallas_whu · 发表于 2023-12-8 21:02:39

谢谢大佬分享

蓝盾设计 · 发表于 2023-12-9 17:57:56

厉害，学习学习

819534890 · 发表于 2023-12-10 11:04:32

看看吧挺好的

账号		自动登录	找回密码
密码			注册

[函数] 获取当前CAD文档的比例尺列表并排序

本帖子中包含更多资源