求大师帮忙看一下

ysq101 · 发表于 2017-10-19 22:59:14

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

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

×

本帖最后由 ysq101 于 2017-10-19 23:05 编辑

如上图...帮忙写个可以判断有这类多线段的LISP 找到后将它们全部改为蓝色

谢谢大师

xinxirong · 发表于 2017-10-19 23:35:16

显然这只是多段线没闭合

牢固 · 发表于 2017-10-20 11:00:36

(defun c:tt (/ A B EN L N NOMAL PTS SS UNIT VXV)
(defun vXv (u v)
(list
(- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
(- (* (car v) (caddr u)) (* (car u) (caddr v)))
(- (* (car u) (cadr v)) (* (car v) (cadr u)))
)
)
(defun unit (v / a)
(setq a (sqrt (apply '+ (mapcar '* v v))))
(if (not (equal a 1e-6))
(mapcar '/ v (list a a a))
)
)
(if (setq ss (ssget '((0 . "lwpolyline"))))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq pts (mapcar '(lambda (a) (append (cdr a) '(0)))
(vl-remove-if-not
'(lambda (x) (= (car x) 10))
(entget en)
)
)
)
(if (equal (car pts) (last pts) 1e-6)
(setq pts (reverse (cdr (reverse pts))))
)
(setq pts (append (cons (last pts) pts) (list (car pts))))
(setq l (mapcar 'list pts (cdr pts) (cddr pts)))
(setq a (car l)
l (cdr l)
)
(setq nomal (unit
(vXv (mapcar '- (car a) (cadr a))
(mapcar '- (caddr a) (cadr a))
)
)
)
(print nomal)
(if
(vl-some '(lambda (a)
(setq b (unit
(vXv (mapcar '- (car a) (cadr a))
(mapcar '- (caddr a) (cadr a))
)
)
)
(print b)
(not
(equal nomal
b
1e-6
)
)
)
l
)
(entmod (append (entget en) '((62 . 1))))
)
)
)
(princ)
)

(defun c:tt (/ A B EN L N NOMAL PTS SS UNIT VXV) 
  (defun vXv (u v) 
    (list 
      (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u))) 
      (- (* (car v) (caddr u)) (* (car u) (caddr v))) 
      (- (* (car u) (cadr v)) (* (car v) (cadr u))) 
    ) 
  ) 
  (defun unit (v / a) 
    (setq a (sqrt (apply '+ (mapcar '* v v)))) 
    (if        (not (equal a 1e-6)) 
      (mapcar '/ v (list a a a)) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "lwpolyline")))) 
    (repeat (setq n (sslength ss)) 
      (setq en (ssname ss (setq n (1- n)))) 
      (setq pts        (mapcar        '(lambda (a) (append (cdr a) '(0))) 
                        (vl-remove-if-not 
                          '(lambda (x) (= (car x) 10)) 
                          (entget en) 
                        ) 
                ) 
      ) 
      (if (equal (car pts) (last pts) 1e-6) 
        (setq pts (reverse (cdr (reverse pts)))) 
      ) 
      (setq pts (append (cons (last pts) pts) (list (car pts)))) 
      (setq l (mapcar 'list pts (cdr pts) (cddr pts))) 
      (setq a (car l) 
            l (cdr l) 
      ) 
      (setq nomal (unit 
                    (vXv (mapcar '- (car a) (cadr a)) 
                         (mapcar '- (caddr a) (cadr a)) 
                    ) 
                  ) 
      ) 
      (print nomal) 
 
      (if 
        (vl-some '(lambda (a) 
                    (setq b (unit 
                              (vXv (mapcar '- (car a) (cadr a)) 
                                   (mapcar '- (caddr a) (cadr a)) 
                              ) 
                            ) 
                    ) 
                    (print b) 
                    (not 
                      (equal nomal 
                             b 
                             1e-6 
                      ) 
                    ) 
                  ) 
                 l 
        ) 
         (entmod (append (entget en) '((62 . 1)))) 
      ) 
    ) 
  ) 
  (princ) 
)

kqqt6236 · 发表于 2017-10-21 00:01:05

佩服，版主就是牛！

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

[求助] 求大师帮忙看一下

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

浏览过的版块