直线或多段线小调整

梦里水香

有时候碰到一些外来图画得不是很规范，有这个程序好多了。

半听可乐

梦里水香 发表于 2012-12-31 23:35
有时候碰到一些外来图画得不是很规范，有这个程序好多了。

非常实用，请问什么是轻多段线？

zzc83

这功能要能批量修改才好用，可以定义以左、右边夹点为基准的批量规正

自贡黄明儒

这个功能同highflybird的图元归整差不多。

goldwheat

这个程序很好用。多谢楼主分享。

mj0000

这玩意不错

扶风

一如既往的挺这种看似简单却很实用的lsp

mjz521yy

支持一下，不错，实用

ynhh

长老的内容
有实用价值
(defun c:ww (/ 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)
)

inhoo

要能框选且能指定以基点调整 就完美了