梦里水香 发表于 2012-12-31 23:35:24

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

半听可乐 发表于 2013-1-1 00:41:22

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

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

zzc83 发表于 2013-1-1 10:38:45

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

自贡黄明儒 发表于 2013-2-4 21:08:44

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

goldwheat 发表于 2014-1-6 11:48:02

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

mj0000 发表于 2014-1-13 14:27:27

这玩意不错

扶风 发表于 2014-2-17 13:04:59

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

mjz521yy 发表于 2014-2-20 12:07:47


支持一下，不错，实用

ynhh 发表于 2014-2-20 13:17:46

长老的内容
有实用价值
(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 发表于 2014-7-15 22:11:07

要能框选且能指定以基点调整 就完美了
页: 1 [2] 3
查看完整版本: 直线或多段线小调整