API应用检查坐标

st788796 · 发表于 2014-7-27 04:51:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

校对一位老兄的总图，老同志只会一笔笔画，坐标是一根线一个字样的画出来，没办法不习惯用新东西，这样的图校对起来就非常麻烦，好在可以把标注筛选出来，而且绝大部分的单个标注中的实体是顺序生成的，于是花几分钟写了个校对程序

(defun c:tt (/ ss lst nl)
(if (setq ss (ssget '((0 . "text,line"))))
(progn
(setq lst (xdrx_pickset->ents ss))
(while lst
(setq nl (cons (list (car lst)
(cadr lst)
(caddr lst)
(cadddr lst)
)
nl
)
lst (cddddr lst)
)
)
(mapcar
'(lambda (x / ln tn tl)
(setq ln (apply
'append
(mapcar
'(lambda (b)
(mapcar
'(lambda (c)
(mapcar '(lambda (d)
(rtos d 2 3)
)
c
)
)
(list
(cdr
(reverse (vlax-curve-getstartpoint b))
)
(cdr (reverse (vlax-curve-getendpoint b))
)
)
)
)
(vl-remove-if
'(lambda (a)
(/= (xdrx_getpropertyvalue a "IsA")
"AcDbLine"
)
)
x
)
)
)
tn (mapcar '(lambda (c)
(vl-string-trim "XY= " c)
)
(acad_strlsort
(mapcar
'(lambda (b)
(xdrx_getpropertyvalue b "Textstring")
)
(setq
tl (vl-remove-if
'(lambda (a)
(/= (xdrx_getpropertyvalue a "IsA")
"AcDbText"
)
)
x
)
)
)
)
)
)
(if (not (member tn ln))
(mapcar '(lambda (a)
(xdrx_entity_setcolor a 7)
)
tl
)
(mapcar '(lambda (a)
(xdrx_entity_setcolor a 1)
)
tl
)
)
)
nl
)
)
)
(princ)
)

(defun c:tt (/ ss lst nl) 
  (if (setq ss (ssget '((0 . "text,line")))) 
    (progn 
      (setq lst (xdrx_pickset->ents ss)) 
      (while lst 
        (setq nl  (cons        (list (car lst) 
                              (cadr lst) 
                              (caddr lst) 
                              (cadddr lst) 
                        ) 
                        nl 
                  ) 
              lst (cddddr lst) 
        ) 
      ) 
      (mapcar 
        '(lambda (x / ln tn tl) 
           (setq ln (apply 
                      'append 
                      (mapcar 
                        '(lambda (b) 
                           (mapcar 
                             '(lambda (c) 
                                (mapcar        '(lambda (d) 
                                           (rtos d 2 3) 
                                         ) 
                                        c 
                                ) 
                              ) 
                             (list 
                               (cdr 
                                 (reverse (vlax-curve-getstartpoint b)) 
                               ) 
                               (cdr (reverse (vlax-curve-getendpoint b)) 
                               ) 
                             ) 
                           ) 
                         ) 
                        (vl-remove-if 
                          '(lambda (a) 
                             (/= (xdrx_getpropertyvalue a "IsA") 
                                 "AcDbLine" 
                             ) 
                           ) 
                          x 
                        ) 
                      ) 
                    ) 
                 tn (mapcar '(lambda (c) 
                               (vl-string-trim "XY= " c) 
                             ) 
                            (acad_strlsort 
                              (mapcar 
                                '(lambda (b) 
                                   (xdrx_getpropertyvalue b "Textstring") 
                                 ) 
                                (setq 
                                  tl (vl-remove-if 
                                       '(lambda        (a) 
                                          (/= (xdrx_getpropertyvalue a "IsA") 
                                              "AcDbText" 
                                          ) 
                                        ) 
                                       x 
                                     ) 
                                ) 
                              ) 
                            ) 
                    ) 
           ) 
           (if (not (member tn ln)) 
             (mapcar '(lambda (a) 
                        (xdrx_entity_setcolor a 7) 
                      ) 
                     tl 
             ) 
             (mapcar '(lambda (a) 
                        (xdrx_entity_setcolor a 1) 
                      ) 
                     tl 
             ) 
           ) 
         ) 
        nl 
      ) 
    ) 
  ) 
  (princ) 
)

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

[每日一码] API应用检查坐标

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

浏览过的版块

[每日一码] API应用 检查坐标

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

浏览过的版块

[每日一码] API应用检查坐标