[原创]：改斜归正－－专门对付歪门斜道

daxiangda001

很不错的啊:)

cmssrr520

我顶.....我顶.......

351770141

好东西，谢谢楼主

351770141

在哪下载啊

cyberloner

大家分享下，希望大家喜欢。

yaojing38

好啊
支持阿

蛮子

下载来试试

iluban

在哪里下载啊

fl502

无图看不出来。

nore

可惜，早期的论坛资料都没有了，不知能不能补回来

狼墨

快捷键  ass  斜线归正
(defun c:ass (/ oldosmode e ee e1 e2 p10 dqp dis ang s1 nearp1 p10lst p11 SS N E3)
  (princ"**************正交化直线或轻多段线**********************")
  (COMMAND "UNDO" "BE")
  (setq oldosmode (getvar 'osmode))
  (setvar 'osmode 0)
  (defun makeline(pt1 pt2)
    (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
  )
  (while (setq e (entsel "\n请选择直线或轻多段线:"))
    (setq e1  (car e)
          p1  (cadr e)
          s1(entget e1)
          )
    (cond
      ((= (cdr (assoc 0 s1))"LINE")
       (setq
          p10 (cdr (assoc 10 s1))
          p11 (cdr (assoc 11 s1))
          ang (rem (angle p10 p11) pi)
         )
      )
      ((= (cdr (assoc 0 s1))"LWPOLYLINE")
       (setq nearp1(vlax-curve-getclosestpointto e1 p1 ))
       (foreach x s1
         (if (= (car x)10)(setq p10lst(cons (cdr x) p10lst)))
       )
       (SETQ SS(SSADD))
       (foreach x p10lst
         (SETQ P10LST(cdr p10lst))
         (mapcar '(lambda(y)(makeline x y)(SSADD (ENTLAST) SS))p10lst)         
       )
       (REPEAT (SETQ N (SSLENGTH SS))
         (IF (EQUAL(DISTANCE nearp1(vlax-curve-getclosestpointto (SETQ E3(SSNAME SS (SETQ N(1- N)))) nearp1 ))0.0 1E-3)
            (setq
               p10 (REVERSE(CDR(REVERSE (cdr (assoc 10 (ENTGET E3))))))
               p11 (REVERSE(CDR(REVERSE (cdr (assoc 11 (ENTGET E3))))))
               ang (rem (angle p10 p11) pi)
              )          
         )
       )
       (COMMAND "ERASE" SS "")
      )
    )
    (if (> ang (/ pi 2))(setq ang (abs(- ang pi))))
    (cond
      ((and(<(distance p1 p10)(distance p1 p11))
           (< ang (/ pi 4))
           )
       (if(= (cdr (assoc 0 s1))"LINE")
          (entmod (subst (cons 11 (list (car p11)(cadr p10)))(cons 11 p11)s1))
          (entmod (subst (cons 10 (list (car p11)(cadr p10)))(cons 10 p11)s1))
         )
      )
      ((and(>(distance p1 p10)(distance p1 p11))
           (< ang (/ pi 4))
           )
       (if(= (cdr (assoc 0 s1))"LINE")
         (entmod (subst (cons 10 (list (car p10)(cadr p11)))(cons 10 p10)s1))
         (entmod (subst (cons 10 (list (car p10)(cadr p11)))(cons 10 p10)s1))
         )
      )
      ((and(<(distance p1 p10)(distance p1 p11))
           (> ang (/ pi 4))
           )
       (if(= (cdr (assoc 0 s1))"LINE")
         (entmod (subst (cons 11 (list (car p10)(cadr p11)))(cons 11 p11)s1))
         (entmod (subst (cons 10 (list (car p10)(cadr p11)))(cons 10 p11)s1))
         )
      )
      ((and(>(distance p1 p10)(distance p1 p11))
           (> ang (/ pi 4))
           )
       (if(= (cdr (assoc 0 s1))"LINE")
         (entmod (subst (cons 10 (list (car p11)(cadr p10)))(cons 10 p10)s1))
         (entmod (subst (cons 10 (list (car p11)(cadr p10)))(cons 10 p10)s1))
         )
      )
      )
  )
  (setvar 'osmode oldosmode)
  (COMMAND "UNDO" "E")
  (princ)
)

kmliro_2017

不错，谢谢分享！！！！！