[討論] 多條線段一起執行"斷開於點"

Atsai 寫到:是這個效果吧！

susupipig 寫到:請問蘋果爸~
目前討論的這支lsp
跟你多年前寫的
似乎不太一樣
以前的可以設定切斷距離
還可以找得到這支lsp嗎??

代碼:


(defun c:brr (/ ss pts pte e gap pt1 pt2 l)
  (setq cmdecho (getvar "cmdecho"))
  (setq os (getvar "osmode"))
  (setvar "cmdecho" 0)

  (setq ss nil)
  (setq pts nil)
  (setq pte nil)
  (setq e nil)
  (setq gap nil)

  (setq gap (getreal "\n打斷的間隙<0>:"))
  (if (= gap nil)
    (setq gap 0)
  )

  (prompt "\n選擇『被』斷開的線:")
  (setq ss (ssget '((0 . "line"))))
  (setq e (car (entsel "\n選擇切割線:<右鍵跳過>")))
  (if (= e nil)
    (progn
      (setq pts (getpoint "\n切割線『起』點:"))
      (setq pte (getpoint pts "\n切割線『終』點:"))
    )
    (progn
      (setq pts (cdr (assoc 10 (entget e))))
      (setq pte (cdr (assoc 11 (entget e))))
    )
  )

  (setq l (sslength ss))
  (setq i 0)
  (repeat l
    (setq pt1 nil)
    (setq pt2 nil)
    (setq pt1 (cdr (assoc 10 (entget (ssname ss i)))))
    (setq pt2 (cdr (assoc 11 (entget (ssname ss i)))))
    (setq pt (inters pts pte pt1 pt2))

    (if   (> (distance pt pt1) (* gap 0.5))
      (setq pt1a (polar pt (angle pt pt1) (* gap 0.5)))
      (setq pt1a pt1)
    )

    (if   (> (distance pt pt2) (* gap 0.5))
      (setq pt2a (polar pt (angle pt pt2) (* gap 0.5)))
      (setq pt2a pt2)
    )

    (command "break" (ssname ss i) pt1a pt2a)
    (setq i (1+ i))
  )

  (setvar "osmode" os)
  (setvar "cmdecho" cmdecho)
  (princ "\nOK!")
  (princ)
)


Tiger&蘋果爸 寫到:

Atsai 寫到:是這個效果吧！

Atsai 特地寫了一個程式嗎！厲害厲害～

susupipig 寫到:請問蘋果爸~
目前討論的這支lsp
跟你多年前寫的
似乎不太一樣
以前的可以設定切斷距離
還可以找得到這支lsp嗎??

這是11年前那時奇摩知識+的文章，另外分享在「AutoCAD指南」奇摩家族！
花了一些時間終於找到...我都忘了說！
載點如下：

Atsai 寫到:下面的程式跟蘋果爸分享的差不多，試用看看吧！

代碼:


(defun c:brr (/ ss pts pte e gap pt1 pt2 l)
  (setq cmdecho (getvar "cmdecho"))
  (setq os (getvar "osmode"))
  (setvar "cmdecho" 0)

  (setq ss nil)
  (setq pts nil)
  (setq pte nil)
  (setq e nil)
  (setq gap nil)

  (setq gap (getreal "\n打斷的間隙<0>:"))
  (if (= gap nil)
    (setq gap 0)
  )

  (prompt "\n選擇『被』斷開的線:")
  (setq ss (ssget '((0 . "line"))))
  (setq e (car (entsel "\n選擇切割線:<右鍵跳過>")))
  (if (= e nil)
    (progn
      (setq pts (getpoint "\n切割線『起』點:"))
      (setq pte (getpoint pts "\n切割線『終』點:"))
    )
    (progn
      (setq pts (cdr (assoc 10 (entget e))))
      (setq pte (cdr (assoc 11 (entget e))))
    )
  )

  (setq l (sslength ss))
  (setq i 0)
  (repeat l
    (setq pt1 nil)
    (setq pt2 nil)
    (setq pt1 (cdr (assoc 10 (entget (ssname ss i)))))
    (setq pt2 (cdr (assoc 11 (entget (ssname ss i)))))
    (setq pt (inters pts pte pt1 pt2))

    (if (> (distance pt pt1) (* gap 0.5))
      (setq pt1a (polar pt (angle pt pt1) (* gap 0.5)))
      (setq pt1a pt1)
    )

    (if (> (distance pt pt2) (* gap 0.5))
      (setq pt2a (polar pt (angle pt pt2) (* gap 0.5)))
      (setq pt2a pt2)
    )

    (command "break" (ssname ss i) pt1a pt2a)
    (setq i (1+ i))
  )

  (setvar "osmode" os)
  (setvar "cmdecho" cmdecho)
  (princ "\nOK!")
  (princ)
)


susupipig 寫到:感謝蘋果爸~
但很奇怪...開始執行後在"選取主線段:"時，就點選不到我想切的線段耶...

Tiger&蘋果爸 寫到:

susupipig 寫到:感謝蘋果爸~
但很奇怪...開始執行後在"選取主線段:"時，就點選不到我想切的線段耶...

我試過沒有問題，可否再試試看～

Tiger&蘋果爸 寫到:

naruto018 寫到:也可以使用巨集
連續使用切斷於點
*^C^C_break \_f \@

這個巨集我也會用到
日前有在網路上搜尋到「lisp程式」可以快速達成
需要「lisp程式」的朋友請加入討論
發表你的作法，稍後再分享「lisp程式」(*回覆可見*)。

指令 BreakAll -      Break all objects selected 打破所有選定的對象
指令 BreakwObjects - Break many objects with a single object 用許多對象打破單個對像
指令 BreakObject -   Break a single object with many objects 用單個對象打破多個對像
指令 BreakWith -     Break selected objects with other selected objects 將所選對象與其他所選對像中斷
指令 BreakTouching - Break objects touching the single Break object 打破碰觸單個Break對象的對象
指令 BreakSelected - Break selected objects with any  objects that touch it 使用任何觸摸對象來中斷所選對象

klarencee 寫到:蘋果爸好，我正在試用你的LISP,
用途是在地籍圖上柜一個矩形,然後切斷所有經過矩形的點,之後把所有矩形外的線條刪除,以令檔案縮小。
我試用過breakwith 跟breaktouching ,覺得應該是breaktouching好用,畢竟只需要點一下矩形就好了,但是有個問題就是不管用那個指令..都不能一次把所有線條斷開,每次用完breaktouching.然後把矩形外線條刪除時,總發覺還有些線條還沒斷開成功的.為什麼會這樣呢??

klarencee 寫到:我解決了...用express tools的extrim就沒問題了.執行一次就能完全切斷全部線,...所以應該是插件有問題。