等分辅助线，构造线

纵横八方

;;; 上次看到论坛里有人需要，忘记发了，一段简单的command

(defun c:fz( / n p1 p2 ang1 p0 m)
(setq p1 (getpoint "\n点取第一点："))
(setq p2 (getpoint p1 "\n点取第二点："))
(setq ang1 (angle p1 p2))
(setq n (getint "\n输入等分数："))
(if (null n)  (setq n 2))
(setq p0 (polar p1 ang1 (/ (distance p1 p2) n)))  
  (setq m 0)
  (repeat (- n 1)  
  (command "xline" "b" "non" p0 "non" p1 "non" p2 "")
  (setq m (+ m 1))
  (setq p0 (polar p0 ang1 (/ (distance p1 p2) n)))
  )
  )

;在分享一个平行等分的
(defun c:PXDF(/ i n obj1 obj2 pl1 pl1lst pl2 pl2lst pl3 pl4 pt1 pt2 u v)
(if (and (setq obj1 (entsel "点取直线段1:") obj2 (entsel "点取直线段2:")))
(progn
(setq pl1lst (HH:PickSegEndPt (car obj1) (cadr obj1)))
(setq pl2lst (HH:PickSegEndPt (car obj2) (cadr obj2)))
(setq pl1 (car pl1lst) pl2 (cadr pl1lst))
(setq pl3 (car pl2lst) pl4 (cadr pl2lst))
(if (inters pl1 pl3 pl2 pl4) (mapcar 'set '(pl1 pl2 pl3 pl4) (LIST pl1 pl2 pl4 pl3)))
(SETQ U (MAPCAR '- PL3 PL1));;
(SETQ V (MAPCAR '- PL4 PL2));;
(setq n (getint "\n输入等分数:"))
(setq i 1)
(repeat (- N 1)
(SETQ PT1 (MAPCAR '+ pL1 (MAT:vxs U (* i (/ 1.0 N)))));;
(SETQ PT2 (MAPCAR '+ pL2 (MAT:vxs V (* i (/ 1.0 N)))));;
(entmake (list '(0 . "line")(cons 62 6)(cons 10 PT1)(cons 11 PT2)))
(setq i (1+ i))
)
)
)
(princ)
)

(defun MAT:vxs ( v s )
  (mapcar (function (lambda ( n ) (* n s))) v)
)

(defun HH:PickSegEndPt (obj p / n pp)
(cond
        ((= (cdr (assoc 0 (entget obj))) "LWPOLYLINE")
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n  (fix (vlax-curve-getparamatpoint obj pp))
  )
  (list (vlax-curve-getPointAtParam obj n)
(vlax-curve-getPointAtParam obj (1+ n))
  )
)
((= (cdr (assoc 0 (entget obj))) "LINE")
         (list
                 (cdr (assoc 10 (entget obj)))
                 (cdr (assoc 11 (entget obj)))
         )
         )
)
)

纵横八方

下文没句号。 发表于 2022-10-17 20:37
楼主改好了没，发给我，谢谢

你需要的是平行等分吗 ，已在首页更新

xiangganglv

1. (defun c:de( / n p1 p2 ang1 p0 m)
   
2. 
   
3. (setq p1 (getpoint "\n点取第一点："))
   
4. 
   
5. (setq p2 (getpoint p1 "\n点取第二点："))
   
6. 
   
7. (setq ang1 (angle p1 p2))
   
8. 
   
9. (setq n (getint "\n输入等分数："))
   
10. 
    
11. (if (null n)  (setq n 2))
    
12. 
    
13. (setq p0 (polar p1 ang1 (/ (distance p1 p2) n)))  
    
14. 
    
15.   (setq m 0)
    
16. 
    
17.   (repeat (- n 1)  
    
18. 
    
19.   (entmake (list '(0 . "POINT") (cons 10 p0)))
    
20. 
    
21.   (setq m (+ m 1))
    
22. 
    
23.   (setq p0 (polar p0 ang1 (/ (distance p1 p2) n)))
    
24. 
    
25.   )
    
26. 
    
27.   )

(defun c:de( / n p1 p2 ang1 p0 m)<br /> <br /> (setq p1 (getpoint "\n点取第一点："))<br /> <br /> (setq p2 (getpoint p1 "\n点取第二点："))<br /> <br /> (setq ang1 (angle p1 p2))<br /> <br /> (setq n (getint "\n输入等分数："))<br /> <br /> (if (null n)  (setq n 2))<br /> <br /> (setq p0 (polar p1 ang1 (/ (distance p1 p2) n)))  <br /> <br />   (setq m 0)<br /> <br />   (repeat (- n 1)  <br /> <br />   (entmake (list '(0 . "POINT") (cons 10 p0)))<br /> <br />   (setq m (+ m 1))<br /> <br />   (setq p0 (polar p0 ang1 (/ (distance p1 p2) n)))<br /> <br />   )<br /> <br />   )

我常用的是点，随手改的。

mpk023

ketxu 发表于 2019-10-31 18:20
Why don't you use Divide or Measure built-in command  ?

不是那个意思，那两个内置命令是可以用的，不过和我想像的有点差别

夺天工

he378980280

谢谢分享 。。。

mpk023

你这个只能平分两点间的，能帮忙写一个平分多段线的LSP么？？？

纵横八方

多段线不是直接div或me吗

ketxu

mpk023 发表于 2019-10-17 16:11
你这个只能平分两点间的，能帮忙写一个平分多段线的LSP么？？？

Why don't you use Divide or Measure built-in command  ?

暮雨晨曦

感谢分享，下载备用

sbwdx

楼主厉害，谢谢源码，有没有能entmake出手的大神啊

sdbaijiao

谢谢楼主分享。。。。