[编程申请]：求LSP：选择一条LINE线，则此LINE线被等分成4条LINE线且删除原LINE线

lengliqun

求LSP程序：选择一条LINE线，则此LINE线被等分成4条LINE线且删除原LINE线。谢谢。

xyp1964

[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

;;批量LINE线等分成n份并删除原线
(defun c:test ()
  (cmdla0)
  (setq        no1 (ureal 1 "" "\n等分份数" no1)
        n   -1
  )
  (while (not (setq ss (ssget '((0 . "LINE"))))))
  ;;(mkla"test"1)  
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (setq pt1  (dxf 10 (entget s1))
          pt2  (dxf 11 (entget s1))
          leng (/ (distance pt1 pt2) no1)
          rad  (angle pt1 pt2)
    )
    (entdel s1)
    (repeat (fix no1)
      (setq pt11 (polar pt1 rad leng))
      (command "line" pt1 pt11 "")
      (setq pt1 pt11)
    )
  )
  (cmdla1)
)
[/php]

Free-Lancer

2. 
   
3. (defun c:tt (/ n ss e el sp ep d an d1 p1 n m)
   
4.   (if (and (setq n (getint "\n等分份数: "))
   
5.            (setq ss (ssget '((0 . "line"))))
   
6.       )
   
7.     (progn
   
8.       (setq l (sslength ss)
   
9.             m (1- n)
   
10.       )
    
11.       (while (> l 0)
    
12.         (setq e         (ssname ss (setq l (1- l)))
    
13.               el (entget e)
    
14.               sp (vlax-curve-getstartpoint e)
    
15.               ep (vlax-curve-getendpoint e)
    
16.               an (angle sp ep)
    
17.               d         (distance sp ep)
    
18.               d1 (/ d n)
    
19.         )
    
20.         (entmod        (subst (cons 11 (setq p1 (polar sp an d1)))
    
21.                        (assoc 11 el)
    
22.                        el
    
23.                 )
    
24.         )
    
25.         (repeat        m
    
26.           (setq        el (subst (cons 10 p1) (assoc 10 el) el)
    
27.                 el (subst (cons 11 (setq p1 (polar p1 an d1)))
    
28.                           (assoc 11 el)
    
29.                           el
    
30.                    )
    
31.           )
    
32.           (entmake el)
    
33.         )
    
34.       )
    
35.     )
    
36.   )
    
37.   (princ)
    
38. )
    

<br /> (defun c:tt (/ n ss e el sp ep d an d1 p1 n m)<br />   (if (and (setq n (getint "\n等分份数: "))<br />            (setq ss (ssget '((0 . "line"))))<br />       )<br />     (progn<br />       (setq l (sslength ss)<br />             m (1- n)<br />       )<br />       (while (> l 0)<br />         (setq e         (ssname ss (setq l (1- l)))<br />               el (entget e)<br />               sp (vlax-curve-getstartpoint e)<br />               ep (vlax-curve-getendpoint e)<br />               an (angle sp ep)<br />               d         (distance sp ep)<br />               d1 (/ d n)<br />         )<br />         (entmod        (subst (cons 11 (setq p1 (polar sp an d1)))<br />                        (assoc 11 el)<br />                        el<br />                 )<br />         )<br />         (repeat        m<br />           (setq        el (subst (cons 10 p1) (assoc 10 el) el)<br />                 el (subst (cons 11 (setq p1 (polar p1 an d1)))<br />                           (assoc 11 el)<br />                           el<br />                    )<br />           )<br />           (entmake el)<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

lengliqun

强烈要求在LSP程序中设置默认等分份数为4,谢谢！

xyp1964

N等份更通用！

4等份更简单：
[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

;;批量LINE线等分成4份并删除原线
(defun c:test ()
  (cmdla0)
  (setq n -1)
  (while (not (setq ss (ssget '((0 . "LINE"))))))
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (setq pt1  (dxf 10 (entget s1))
          pt2  (dxf 11 (entget s1))
          leng (/ (distance pt1 pt2) 4)
          rad  (angle pt1 pt2))
    (entdel s1)
    (repeat 4
      (setq pt11 (polar pt1 rad leng))
      (command "line" pt1 pt11 "")
      (setq pt1 pt11)))
  (cmdla1)
)
[/php]

zxq0220

[php]
(DEFUN C:TEST ( / SS SL I SN DL P1 P2 P3 P4 P5 DS ANG)
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(WHILE (SETQ SS (SSGET '((0 . "LINE"))))
  (SETQ SL (SSLENGTH SS) I 0)
  (REPEAT SL
   (SETQ SN (SSNAME SS I) I (1+ I)
         DL (ENTGET SN)
         P1 (CDR (ASSOC 10 DL))
         P2 (CDR (ASSOC 11 DL))
         DS (/ (DISTANCE P1 P2) 4)
         ANG (ANGLE P1 P2)
         P3 (POLAR P1 ANG DS)
         P4 (POLAR P3 ANG DS)
         P5 (POLAR P4 ANG DS))
   (COMMAND "REASE" SN "" "LINE" P1 P3 P4 P5 P2 "")
  )
)
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)
[/php]

lengliqun

谢谢，经测试都可用，谢谢xyp1964 、Free-Lancer  、zxq0220  。