线批量变粗功能 源码

雨的节奏

1. (defun c:xk (/ SS DIS VLX ENDATA TYP PTS PTE LST)
   
2. ;(if (null (setq ss (car (gsssget "请选择要改变线宽的线" "0_*E,arc")))) (exit))
   
3. (setq ss (ssget))
   
4. (setq ss (ssget->ename-list ss));自己写函数
   
5. (setq dis (getdist "\n请输入线的宽度"))
   
6. (foreach x ss
   
7.         (setq vlx (vlax-ename->vla-object x)
   
8.               endata (entget x)
   
9.               typ (cdr (assoc 0 endata))
   
10.               pts (vlax-curve-getstartpoint  vlx)
    
11.               pte (vlax-curve-getendpoint  vlx)
    
12.               lst (mapcar '(lambda (x)
    
13.                   (vlax-get-property vlx x))
    
14.                   (list  'Layer 'Linetype 'LinetypeScale 'color)))
    
15.         (cond
    
16.         ((= "LINE" typ)
    
17.         (progn
    
18.           (entmake
    
19.           (list '(0 . "LWPOLYLINE")
    
20.                 '(100 . "AcDbEntity")
    
21.                 '(100 . "AcDbPolyline")
    
22.                 (cons 90 2)
    
23.                 (cons 10 pts)
    
24.                 (cons 10 pte)
    
25.                 )
    
26.             );end enmake
    
27.           (mapcar '(lambda (x y)
    
28.                    (vlax-put-property  (vlax-ename->vla-object (entlast)) x y))  
    
29.                    (list 'Layer 'Linetype 'LinetypeScale 'color) lst)
    
30.           (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidth  dis)
    
31.           (entdel x)
    
32.         ));end condline
    
33.         ((= "CIRCLE" typ)
    
34.          (progn
    
35.          (circle_ploy endata)
    
36.          (mapcar '(lambda (x y)
    
37.                    (vlax-put-property  (vlax-ename->vla-object (entlast)) x y))  
    
38.                    (list 'Layer 'Linetype 'LinetypeScale 'color) lst)
    
39.           (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidth  dis)
    
40.           (entdel x)
    
41.          ));end conrcircle
    
42.         ((= "LWPOLYLINE" typ)  (vlax-put-property vlx 'ConstantWidth  dis))
    
43.          (T
    
44.          (progn
    
45.          (setvar "PEDITACCEPT" 1)
    
46.          (vl-cmdf  "._pedit" x "")
    
47.          (mapcar '(lambda (x y)
    
48.                    (vlax-put-property  (vlax-ename->vla-object (entlast)) x y))  
    
49.                    (list 'Layer 'Linetype 'LinetypeScale 'color) lst)
    
50.           (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidth  dis)
    
51.           ;(entdel x)
    
52.          ));end conrcircle
    
53.         
    
54.         );end cond
    
55.       
    
56.         
    
57. );end foreach
    
58. (princ "\n***********************完成*********GS石材自动下单软件 出品 程序订制 老蒋179174787*********")
    
59. (prin1)
    
60. )
    
61. ;;圆转多段线
    
62. (defun circle_ploy (entlst / NORM CENTER R PRO_X)
    
63.     (setq norm  (assoc 67 entlst) ;图形在模型空间或图纸空间
    
64.           center (assoc 10 entlst) ;圆心
    
65.           r  (cdr (assoc 40 entlst)) ;半径
    
66.           pro_x  (assoc 210 entlst) ;X轴拉伸方向
    
67.           ) ;_ 结束setq
    
68.     (entmake
    
69.    (list
    
70.      '(0 . "LWPOLYLINE")
    
71.      '(100 . "AcDbEntity")
    
72.      norm
    
73.      '(410 . "Model")
    
74.      '(100 . "AcDbPolyline")
    
75.      '(90 . 3)
    
76.      '(70 . 0)
    
77.      '(43 . 0.0)
    
78.      '(38 . 0.0)
    
79.      '(39 . 0.0)
    
80.      (list 10 (cadr center) (- (caddr center) r))
    
81.      '(40 . 0.0)
    
82.      '(41 . 0.0)
    
83.      '(42 . 1.0)
    
84.      '(91 . 0)
    
85.      (list 10 (cadr center) (+ r (caddr center)))
    
86.      '(40 . 0.0)
    
87.      '(41 . 0.0)
    
88.      '(42 . 1.0)
    
89.      '(91 . 0)
    
90.      (list 10 (cadr center)  (- (caddr center) r))
    
91.      '(40 . 0.0)
    
92.      '(41 . 0.0)
    
93.      '(42 . 0.46903)
    
94.      '(91 . 0)
    
95.      pro_x
    
96.       ) ;_ 结束list
    
97.    );end entmake
    
98. ) ;_ 结束defun
    
99. (PRIN1)

(defun c:xk (/ SS DIS VLX ENDATA TYP PTS PTE LST)<br /> ;(if (null (setq ss (car (gsssget "请选择要改变线宽的线" "0_*E,arc")))) (exit))<br /> (setq ss (ssget))<br /> (setq ss (ssget->ename-list ss));自己写函数<br /> (setq dis (getdist "\n请输入线的宽度"))<br /> (foreach x ss<br />         (setq vlx (vlax-ename->vla-object x) <br />               endata (entget x)<br />               typ (cdr (assoc 0 endata))<br />               pts (vlax-curve-getstartpoint  vlx)<br />               pte (vlax-curve-getendpoint  vlx)<br />               lst (mapcar '(lambda (x) <br />                   (vlax-get-property vlx x)) <br />                   (list  'Layer 'Linetype 'LinetypeScale 'color)))<br />         (cond<br />         ((= "LINE" typ) <br />         (progn<br />           (entmake<br />           (list '(0 . "LWPOLYLINE")<br />                 '(100 . "AcDbEntity")<br />                 '(100 . "AcDbPolyline")<br />                 (cons 90 2)<br />                 (cons 10 pts)<br />                 (cons 10 pte)<br />                 )<br />             );end enmake<br />           (mapcar '(lambda (x y)<br />                    (vlax-put-property  (vlax-ename->vla-object (entlast)) x y))  <br />                    (list 'Layer 'Linetype 'LinetypeScale 'color) lst)<br />           (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidth  dis)<br />           (entdel x)<br />         ));end condline<br />         ((= "CIRCLE" typ)<br />          (progn<br />          (circle_ploy endata)<br />          (mapcar '(lambda (x y)<br />                    (vlax-put-property  (vlax-ename->vla-object (entlast)) x y))  <br />                    (list 'Layer 'Linetype 'LinetypeScale 'color) lst)<br />           (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidth  dis)<br />           (entdel x)<br />          ));end conrcircle<br />         ((= "LWPOLYLINE" typ)  (vlax-put-property vlx 'ConstantWidth  dis))<br />          (T<br />          (progn<br />          (setvar "PEDITACCEPT" 1)<br />          (vl-cmdf  "._pedit" x "")<br />          (mapcar '(lambda (x y)<br />                    (vlax-put-property  (vlax-ename->vla-object (entlast)) x y))  <br />                    (list 'Layer 'Linetype 'LinetypeScale 'color) lst)<br />           (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidth  dis)<br />           ;(entdel x)<br />          ));end conrcircle<br />         <br />         );end cond<br />       <br />         <br /> );end foreach<br /> (princ "\n***********************完成*********GS石材自动下单软件 出品 程序订制 老蒋179174787*********")<br /> (prin1)<br /> )<br /> ;;圆转多段线<br /> (defun circle_ploy (entlst / NORM CENTER R PRO_X)<br />     (setq norm  (assoc 67 entlst) ;图形在模型空间或图纸空间<br />           center (assoc 10 entlst) ;圆心<br />           r  (cdr (assoc 40 entlst)) ;半径<br />           pro_x  (assoc 210 entlst) ;X轴拉伸方向<br />           ) ;_ 结束setq<br />     (entmake <br />    (list <br />      '(0 . "LWPOLYLINE")<br />      '(100 . "AcDbEntity")<br />      norm<br />      '(410 . "Model")<br />      '(100 . "AcDbPolyline")<br />      '(90 . 3)<br />      '(70 . 0)<br />      '(43 . 0.0)<br />      '(38 . 0.0)<br />      '(39 . 0.0)<br />      (list 10 (cadr center) (- (caddr center) r))<br />      '(40 . 0.0)<br />      '(41 . 0.0)<br />      '(42 . 1.0)<br />      '(91 . 0)<br />      (list 10 (cadr center) (+ r (caddr center)))<br />      '(40 . 0.0)<br />      '(41 . 0.0)<br />      '(42 . 1.0)<br />      '(91 . 0)<br />      (list 10 (cadr center)  (- (caddr center) r))<br />      '(40 . 0.0)<br />      '(41 . 0.0)<br />      '(42 . 0.46903)<br />      '(91 . 0)<br />      pro_x<br />       ) ;_ 结束list<br />    );end entmake<br /> ) ;_ 结束defun<br /> (PRIN1)

雨的节奏

magicheno

感谢大神啊，很有用的~~~！！！   源码咋用不了

雨的节奏

magicheno 发表于 2020-3-29 01:22
感谢大神啊，很有用的~~~！！！   源码咋用不了

ssget->ename-list  这个函数自己写

fxlt619

啊哦？都放出来吧。不会啊

magicheno

雨的节奏 发表于 2020-3-29 07:57
ssget->ename-list  这个函数自己写

写不来

雨的节奏

magicheno 发表于 2020-3-29 12:24
写不来

(defun ssget->ename-list (ss / i ename lst)
    (setq i -1)
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq lst (cons ename lst))
    )
    lst
  )

忙出一个未来

PE M W.简单几个操作，不用上插件吧

菜卷鱼

搞那么复杂，为什么不用 (command "chprop" ) ？？？