批量根据多段线绘制图形

炫翔

大家可以先弄图一 再弄图二

wowan1314

2. (defun c:t11 (/ ss )
   
3.     (setq ss (ssget '((0 . "LWPOLYLINE"))) a -1)
   
4.     (while (setq e (ssname ss (setq a (1+ a))))
   
5.         (setq ps (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget e)))
   
6.             ps (cons (car ps)(reverse ps))
   
7.             ps (mapcar 'list ps (cdr ps))
   
8.         )
   
9.         (mapcar '(lambda(x)
   
10.                 (setq p1 (car x)p2(cadr x) pn (yy-np1p2 p1 p2 4))
    
11.                 (command "ARC" "C"  (car pn)  p1 (cadr PN))
    
12.                 (setq banj (* 0.5 (distance (car pn)p1))
    
13.                     cen (polar (car pn) (- (angle p1 p2)(* 0.5 pi)) banj)
    
14.                 )
    
15.                 (command "circle"  cen  banj)
    
16.                 (command "ARC" "C"  (last pn)  p2 (cadr PN))
    
17.                 (setq cen (polar (last pn) (+ (angle p1 p2)(* 0.5 pi)) banj))
    
18.                 (command "circle"  cen  banj)
    
19.             )
    
20.             ps
    
21.         )
    
22.     )
    
23. )
    
24. ;定数等分两点
    
25. (defun YY-np1p2  (p1 p2 n / v m plst)
    
26.   (setq  m 0 v (mapcar '(lambda (x y) (/ (- x y) n)) P2 P1) n (1- n))
    
27.   (while (< m n)
    
28.     (setq m (1+ m)
    
29.      plst (cons (mapcar '(lambda(x y)(- x (* m y))) p2 v) plst)
    
30.      )
    
31.   )
    
32. )

(defun c:t11 (/ ss ) <br />     (setq ss (ssget '((0 . "LWPOLYLINE"))) a -1)<br />     (while (setq e (ssname ss (setq a (1+ a))))<br />         (setq ps (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget e)))<br />             ps (cons (car ps)(reverse ps))<br />             ps (mapcar 'list ps (cdr ps))<br />         )<br />         (mapcar '(lambda(x)<br />                 (setq p1 (car x)p2(cadr x) pn (yy-np1p2 p1 p2 4))<br />                 (command "ARC" "C"  (car pn)  p1 (cadr PN))<br />                 (setq banj (* 0.5 (distance (car pn)p1))<br />                     cen (polar (car pn) (- (angle p1 p2)(* 0.5 pi)) banj)<br />                 )<br />                 (command "circle"  cen  banj)<br />                 (command "ARC" "C"  (last pn)  p2 (cadr PN))<br />                 (setq cen (polar (last pn) (+ (angle p1 p2)(* 0.5 pi)) banj))<br />                 (command "circle"  cen  banj)<br />             )<br />             ps<br />         )<br />     )<br /> )<br /> ;定数等分两点<br /> (defun YY-np1p2  (p1 p2 n / v m plst)<br />   (setq  m 0 v (mapcar '(lambda (x y) (/ (- x y) n)) P2 P1) n (1- n))<br />   (while (< m n)<br />     (setq m (1+ m)<br />      plst (cons (mapcar '(lambda(x y)(- x (* m y))) p2 v) plst)<br />      )<br />   )<br /> )

snsj

郑州斧王，好霸气的名字，就凭你这名字都得灌水顶你

Free-Lancer

边长为直径，难度不大来自: Android客户端

炫翔

Free-Lancer 发表于 2013-7-27 15:31
边长为直径，难度不大

是的，给大家练练手

zhangq_cai1

能不能带短斜线的多线段，1:100比例下短斜线间距1125，长300.如图

ucuc2003

版主练习的越来越复杂了！@

sicky111

这好像是《AUTOLISP&DCL基础篇》中的一个实例吧。

sicky111

书上的是个三角形，也可以算是多边形。

郑州斧王

看不懂 大神 我是菜鸟

郑州斧王

郑州斧王 发表于 2013-7-29 18:28
看不懂 大神 我是菜鸟

多谢大神  网站不错 但是还不知从哪里开始学

zhangq_cai1

找一本教材，从基础学·······································

ysq101

很好的练习题。。可惜没时间啊~~~~~~~~~

xyp1964

2. 
   
3. (defun c:tt ()
   
4.   (CMDLA0)
   
5.   (setq i -1)
   
6.   (if (setq ss (ssget '((0 . "*polyLINE"))))
   
7.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
8.       (setq ptn        (xyp-get-Vertexs s1 3)
   
9.             ptn        (xyp-list-delsame ptn)
   
10.             ptn        (cons (last ptn) ptn)
    
11.             ptn        (xyp-Ptn2CCW ptn)
    
12.             j        0
    
13.       )
    
14.       (while (and (setq p1 (nth j ptn))
    
15.                   (setq p2 (nth (setq j (1+ j)) ptn))
    
16.              )
    
17.         (setq p3  (xyp-get-MidPoint p1 p2)
    
18.               dd  (* (distance p1 p2) 0.25)
    
19.               ddd (* dd 0.5)
    
20.               p13 (xyp-get-MidPointDn p1 p3 dd)
    
21.               p32 (xyp-get-MidPointUp p3 p2 dd)
    
22.               s2  (xyp-arc-3pt p1 p13 p3)
    
23.               s3  (xyp-arc-3pt p2 p32 p3)
    
24.               s4  (xyp-circle (xyp-get-MidPointDn p1 p3 ddd) ddd)
    
25.               s5  (xyp-circle (xyp-get-MidPointUp p3 p2 ddd) ddd)
    
26.         )
    
27.       )
    
28.     )
    
29.   )
    
30.   (CMDLA1)
    
31. )

<br /> (defun c:tt ()<br />   (CMDLA0)<br />   (setq i -1)<br />   (if (setq ss (ssget '((0 . "*polyLINE"))))<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq ptn        (xyp-get-Vertexs s1 3)<br />             ptn        (xyp-list-delsame ptn)<br />             ptn        (cons (last ptn) ptn)<br />             ptn        (xyp-Ptn2CCW ptn)<br />             j        0<br />       )<br />       (while (and (setq p1 (nth j ptn))<br />                   (setq p2 (nth (setq j (1+ j)) ptn))<br />              )<br />         (setq p3  (xyp-get-MidPoint p1 p2)<br />               dd  (* (distance p1 p2) 0.25)<br />               ddd (* dd 0.5)<br />               p13 (xyp-get-MidPointDn p1 p3 dd)<br />               p32 (xyp-get-MidPointUp p3 p2 dd)<br />               s2  (xyp-arc-3pt p1 p13 p3)<br />               s3  (xyp-arc-3pt p2 p32 p3)<br />               s4  (xyp-circle (xyp-get-MidPointDn p1 p3 ddd) ddd)<br />               s5  (xyp-circle (xyp-get-MidPointUp p3 p2 ddd) ddd)<br />         )<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )