随意角度自动比例修订云线

baogeu88

zgssd 发表于 2020-6-8 16:14
只是原捕捉设置都没有了

你这个在源码程序中自己修改一下就行

ylxn

看起来效果不错哦

海盗曹

好程序，学习一下

nyistjz

发现有个BUG，以任意角度画云线后，会影响到矩形命令的操作，导致绘制角度出错。
另外，常规情况下，大家用水平向布置的情况较多，是否可以默认为水平向，有选择后，才进行任意角度的绘制？

baogeu88

nyistjz 发表于 2020-6-11 15:25
发现有个BUG，以任意角度画云线后，会影响到矩形命令的操作，导致绘制角度出错。
另外，常规情况下，大家 ...

非常感谢提出宝贵的意见

hhwjt

谢谢分享好东西

xiehaoing

感谢分享

依然小小鸟

能加上引线+文字说明就好了

wangsr

用过了好用，

lml2023

修改了一下
(1)加了图层
（2）把其他改为  q

2. ;;任意云线TY
   
3. (defun c:TY(/ x0 y0 x1 y1)
   
4.         (setvar "cmdecho" 0 )
   
5. (setq oldlayer (getvar "clayer"));;加层
   
6. (command-S "_layer" "n" "0-100-修改云线" "c" "6" "0-100-修改云线"  "N" "0-100-修改云线" "") ;;加层,如果"N"后加“P”则为不打印图层
   
7. (setvar "clayer" "0-100-修改云线");;加层
   
8.   (vl-load-com)
   
9.        
   
10.         ------------------------
    
11.         ;设置水平方向默认值
    
12.        
    
13.         (setq fx (getstring "\n输入修订云线偏转方向（默认水平-y;其他旋转角度-q）<空格-y>:"))
    
14.        
    
15.         (if (= fx "")
    
16.                 (setq fx "y")                       
    
17.         )
    
18.         (princ fx)
    
19.         ----------------------
    
20.        
    
21.         (SetQ      
    
22.                 p0 (GetPoint "\n 指定第一个修订角点：")                        
    
23.         )
    
24.        
    
25.         ;显示方向，方便查看
    
26.         (if (= fx "y")
    
27.                 (Command "rectang" p0 "r"  0  pause )
    
28.                 (progn
    
29.                         (princ "\n指定角度方向")
    
30.                         (command "line" p0 pause "")
    
31.                         (setq xl (entlast))
    
32.                         (setq xdata (entget xl))
    
33.                         (setq pend (cdr (assoc 11 xdata)))
    
34.                         (grdraw p0 pend 2)       
    
35.                         (setq angl (bao-rtd (angle p0 pend)))
    
36.                         (entdel xl);显示完成，删除
    
37.                         (princ "\n点选云线框角点")
    
38.                         (Command "rectang" p0 "r"  angl  pause )
    
39.                 )
    
40.         )
    
41.         -------------------------------------------------       
    
42.         ;设定比例弧长
    
43.         (setq xx (entlast))
    
44.         (setq edata (entget xx))
    
45.        
    
46.   (setq plst (bao_get_vertexs  xx)) ;获取矩形四个顶点坐标
    
47.         (setq pp1 (car plst)
    
48.                 pp2 (cadr plst)
    
49.                 pp3 (caddr plst)
    
50.                 pp4 (cadddr plst)               
    
51.         )
    
52.         (setq dis1 (distance pp1 pp2)
    
53.                 dis2 (distance pp2 pp3)
    
54.         )
    
55.        
    
56.         (if(<= dis1 dis2)
    
57.                 (SetQ alenth (/ dis1 8))
    
58.                 (SetQ alenth (/ dis2 8))               
    
59.         )
    
60.        
    
61.         (Command "revcloud" "a" alenth alenth "s" "c" "o" "l" "")
    
62.        
    
63.         -------------------------
    
64.         ;返回矩形默认水平作图方向
    
65.         (Command "rectang" p0 "r"  0  pp3 )
    
66.         (setq xx (entlast))
    
67.         (entdel xx)
    
68.         ------------------------------
    
69.         (setvar "cmdecho" 1)
    
70.         (princ)
    
71. )
    
72. ;;弧度转换为度
    
73. (defun bao-rtd (ang) (/ (* ang 180.0) pi))
    
74. ;;度转换为弧度
    
75. (defun bao-dtr (ang) (* (/ ang 180.0) pi))
    
76. 
    
77. ;;获取矩形顶点
    
78. (defun bao_get_vertexs (en)
    
79.         (mapcar 'cdr (vl-remove-if-not
    
80.                                                                  '(lambda (x) (= (car x) 10))
    
81.                                                                  (entget en)
    
82.                                                          )       
    
83.         )
    
84. )
    

;;任意云线TY<br /> (defun c:TY(/ x0 y0 x1 y1)<br />         (setvar "cmdecho" 0 )<br /> (setq oldlayer (getvar "clayer"));;加层<br /> (command-S "_layer" "n" "0-100-修改云线" "c" "6" "0-100-修改云线"  "N" "0-100-修改云线" "") ;;加层,如果"N"后加“P”则为不打印图层<br /> (setvar "clayer" "0-100-修改云线");;加层<br />   (vl-load-com)<br />         <br />         ------------------------<br />         ;设置水平方向默认值<br />         <br />         (setq fx (getstring "\n输入修订云线偏转方向（默认水平-y;其他旋转角度-q）<空格-y>:"))<br />         <br />         (if (= fx "")<br />                 (setq fx "y")                        <br />         )<br />         (princ fx)<br />         ----------------------<br />         <br />         (SetQ      <br />                 p0 (GetPoint "\n 指定第一个修订角点：")                         <br />         )<br />         <br />         ;显示方向，方便查看<br />         (if (= fx "y")<br />                 (Command "rectang" p0 "r"  0  pause )<br />                 (progn<br />                         (princ "\n指定角度方向")<br />                         (command "line" p0 pause "")<br />                         (setq xl (entlast))<br />                         (setq xdata (entget xl))<br />                         (setq pend (cdr (assoc 11 xdata)))<br />                         (grdraw p0 pend 2)        <br />                         (setq angl (bao-rtd (angle p0 pend)))<br />                         (entdel xl);显示完成，删除<br />                         (princ "\n点选云线框角点")<br />                         (Command "rectang" p0 "r"  angl  pause )<br />                 )<br />         )<br />         -------------------------------------------------        <br />         ;设定比例弧长<br />         (setq xx (entlast))<br />         (setq edata (entget xx))<br />         <br />   (setq plst (bao_get_vertexs  xx)) ;获取矩形四个顶点坐标<br />         (setq pp1 (car plst)<br />                 pp2 (cadr plst)<br />                 pp3 (caddr plst)<br />                 pp4 (cadddr plst)                <br />         )<br />         (setq dis1 (distance pp1 pp2)<br />                 dis2 (distance pp2 pp3)<br />         )<br />         <br />         (if(<= dis1 dis2)<br />                 (SetQ alenth (/ dis1 8))<br />                 (SetQ alenth (/ dis2 8))                <br />         )<br />         <br />         (Command "revcloud" "a" alenth alenth "s" "c" "o" "l" "")<br />         <br />         -------------------------<br />         ;返回矩形默认水平作图方向<br />         (Command "rectang" p0 "r"  0  pp3 )<br />         (setq xx (entlast))<br />         (entdel xx)<br />         ------------------------------<br />         (setvar "cmdecho" 1)<br />         (princ)<br /> )<br /> ;;弧度转换为度<br /> (defun bao-rtd (ang) (/ (* ang 180.0) pi))<br /> ;;度转换为弧度<br /> (defun bao-dtr (ang) (* (/ ang 180.0) pi))<br /> <br /> ;;获取矩形顶点<br /> (defun bao_get_vertexs (en)<br />         (mapcar 'cdr (vl-remove-if-not <br />                                                                  '(lambda (x) (= (car x) 10)) <br />                                                                  (entget en)<br />                                                          )        <br />         )<br /> )<br />