社区 › AutoLISP/Visual LISP 编程技术 › 求画直线相交断己

weiqi 发表于 2012-12-7 17:31:44

求画直线相交断己

同一图层只有 line线性求可以 输入打断距离

画 line线时 遇到 同图层line线时 打断自己

请高手指教，求相应教程

qq25469005 发表于 2019-4-30 15:00:34

xyp1964 发表于 2012-12-8 06:59


这个可以发下给我吗，很需要:'(

edsion24 发表于 2019-6-19 08:45:59

老大能不能做个多段线同样功能的。

Gu_xl 发表于 2012-12-7 21:52:55

(defun c:tt (/ LA P0 PT S PL A)
(setq la (getvar 'clayer))
(setq p0 (getpoint "\n第一点:"))
(while (setq pt (getpoint p0 "\n下一点:"))
    (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
    (if        s
      
      (progn
        (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
        (setq a p0)
        (foreach b pl
          (entmake
          (list '(0 . "line")
                  (cons 10 a)
                  (cons 11 b)
          )
          )
          (setq a b)
        )
        (entmake
          (list        '(0 . "line")
                (cons 10 a)
                (cons 11 pt)
          )
        )
      )
      (entmake
        (list '(0 . "line")
              (cons 10 p0)
              (cons 11 pt)
        )
      )
    )
    (setq p0 pt)
)
(princ)
)

Gu_xl 发表于 2012-12-7 22:01:39

Gu_xl 发表于 2012-12-7 21:52 static/image/common/back.gif


输入距离打断，更简单！自己思考吧！

weiqi 发表于 2012-12-8 02:09:37

(defun c:tt (/ LA P0 PT S PL A)
(setq numdd (getint "请输入打断距离:"))
(setq numdd (/ numdd 2))
(setq la (getvar 'clayer))
(setq p0 (getpoint "\n第一点:"))
(while (setq pt (getpoint p0 "\n下一点:"))
    (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
    (if      s

      (progn
      (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
      (setq a p0)
                (setq jd (angle (list (car p0) (cadr p0)) (list (car pt) (cadr pt)) ))
                (print jd)
               
               
               
      (foreach b pl
       
               
          (entmake
            (list '(0 . "line")
                  (cons 10 a)
                  (cons 11 b)
            )
          )
          (setq a b)
      )
                        (setq zd2 (list (+ (car a) (* (cos jd) numdd)) (+ (cadr a) (* (sin jd) numdd)) (caddr a)) )
      (entmake
          (list      '(0 . "line")
                (cons 10 zd2)
                (cons 11 pt)
          )
      )
      )
      (entmake
      (list '(0 . "line")
            (cons 10 p0)
            (cons 11 pt)
      )
      )
    )
    (setq p0 pt)
)
(princ)
)


暂时做会做 打断一边的。这切做得不好。
不懂的地方很多。（cons 0 "line") (cons 8 la)
是什么意思？ (list '(0 . "line")
            (cons 10 p0)
            (cons 11 pt)
      )
查了下 cons是AutoLISP的基本表构造函数。
实例
    (cons 'a' (b c d))    ; ; ; 返回（A B C D）

请问 看什么开发手册呢

weiqi 发表于 2012-12-8 02:14:47

本帖最后由 weiqi 于 2012-12-8 02:16 编辑

双边的话 交点处 会多出 一条线且多个交点的时候，只断了 最后一个的距离。

(defun c:tt (/ LA P0 PT S PL A)
(setq numdd (getint "请输入打断距离:"))
(setq numdd (/ numdd 2))
(setq la (getvar 'clayer))
(setq p0 (getpoint "\n第一点:"))
(while (setq pt (getpoint p0 "\n下一点:"))
    (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
    (if      s

      (progn
      (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
      (setq a p0)
                (setq jd (angle (list (car p0) (cadr p0)) (list (car pt) (cadr pt)) ))
                (print jd)
               
               
               
      (foreach b pl
         (setq zd1 (list (- (car b) (* (cos jd) numdd)) (- (cadr b) (* (sin jd) numdd)) (caddr b)) );;中点第一点
               
          (entmake
            (list '(0 . "line")
                  (cons 10 a)
                  (cons 11 zd1)
            )
          )
          (setq a b)
      )
          (setq zd2 (list (+ (car a) (* (cos jd) numdd)) (+ (cadr a) (* (sin jd) numdd)) (caddr a)) );;中点第二点
      (entmake
          (list      '(0 . "line")
                (cons 10 zd2)
                (cons 11 pt)
          )
      )
      )
      (entmake
      (list '(0 . "line")
            (cons 10 p0)
            (cons 11 pt)
      )
      )
    )
    (setq p0 pt)
)
(princ)
)

weiqi 发表于 2012-12-8 02:52:52

我基础 太差了，望高手指点指点。

xyp1964 发表于 2012-12-8 06:59:26

Gu_xl 发表于 2012-12-11 13:45:23

Gu_xl 发表于 2012-12-7 21:52 static/image/common/back.gif



(defun c:tt(/ LA P0 PT S PL A d)
(setq d (getdist "\n打断距离<0>:"))
(if (null d)
    (setq d 0))
(setq d (* 0.5 d))
(setq la (getvar 'clayer))
(setq p0 (getpoint "\n第一点:"))
(while (setq pt (getpoint p0 "\n下一点:"))
    (setq s
           (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
    (if        s

      (progn
        (setq pl
             (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
        (setq a p0)
        (foreach bpl
          (if (not (equal p0 b (* 0.1 d)))
          (progn
              (entmake
                (list '(0 . "line")
                      (cons 10 a)
                      (cons 11 (polar b (angle pt p0) d))
                      )
                )
              (setq a (polar b (angle p0 pt) d))
              )
          )
          )
        (entmake
          (list        '(0 . "line")
                (cons 10 a)
                (cons 11 pt)
                )
          )
        )
      (entmake
        (list '(0 . "line")
              (cons 10 p0)
              (cons 11 pt)
              )
        )
      )
    (setq p0 pt)
    )
(princ)
)

start4444 发表于 2013-9-4 16:49:38

很好的命令收藏了先

香田里浪人 发表于 2013-9-4 19:02:52

下载下来，以备需要时使用。

查看完整版本: 求画直线相交断己