这样的圆拖拉变形

戏男

如图，在输入指定的红色中心线总长度后，可以动态拖拉成不同长宽，保证4MM不变，怎么做到啊？

输入的值如果能设置为中心线或外围线，内圈线的值更好，需要lisp的程序

liuhe

2. (DEFUN C:TT (/ PT ZC ERR LOOP GR CODE PC L1 R PTT ANG P1 P2 P3 P4 EC E1
   
3.          E2)
   
4.   (SETQ Pt (GETPOINT "\n插入中心点"))
   
5.   (if (not pt)
   
6.     (vl-exit-with-value 0)
   
7.   )
   
8.   (setq zc (getreal "\n输入周长"))
   
9.   (FOREACH X (LIST "CENTER2" )
   
10.     (setq
    
11.       err (vl-catch-all-apply
    
12.       'vla-Load
    
13.       (list (vla-get-Linetypes
    
14.         (vla-get-ActiveDocument (vlax-get-acad-object))
    
15.       )
    
16.       X
    
17.       "acad.lin"
    
18.       )
    
19.     )
    
20.     )
    
21.     (if  (vl-catch-all-error-p err)
    
22.       (if (= (vl-catch-all-error-message err)
    
23.        "Automation Error. Duplicate record name"
    
24.     )
    
25.   (alert (strcat "A line type named '" X "' already exists."))
    
26.       )
    
27.     )
    
28.   )
    
29.   (setq  loop t)
    
30. (WHILE LOOP
    
31.     (setq gr   (grread t 15 0)
    
32.     code (car gr)
    
33.     Pc   (cadr gr)
    
34.     )
    
35.     (cond
    
36.       ((= code 5)      ; 鼠标移动
    
37.   (redraw)
    
38.        (FOREACH  X (LIST EC E1 E2)
    
39.    (if X
    
40.      (entdel X)
    
41.    )
    
42.        )
    
43.   (setq l1 (distance pt pc)
    
44.         r   (/ (- zc l1 l1) 2 pi)
    
45.   )
    
46.   (IF (> R 4)
    
47.     (PROGN
    
48.       (SETQ ptt pc
    
49.       ANG (ANGLE PT PTT)
    
50.       p1  (polar pt (+ ANG (* 0.5 pi)) r)
    
51.       p2  (polar pt (+ ANG (* 1.5 pi)) r)
    
52.       p3  (polar ptt (+ ANG (* 1.5 pi)) r)
    
53.       p4  (polar ptt (+ ANG (* 0.5 pi)) r)
    
54.       ec  (entmakex  (LIST
    
55.           '(0 . "LWPOLYLINE")
    
56.           '(100 . "AcDbEntity")
    
57.           '(100 . "AcDbPolyline")
    
58.           '(90 . 5)
    
59.           '(70 . 1)
    
60.          
    
61.           (CONS 10 P1)
    
62.           '(42 . 0.0)
    
63.           (CONS 10 P4)
    
64.           '(42 . -1.0)
    
65.           (CONS 10 P3)
    
66.           '(42 . 0.0)
    
67.           (CONS 10 P2)
    
68.           '(42 . -1.0)
    
69.         )
    
70.           )
    
71.       )
    
72.       (VLA-OFFSET (vlax-ename->vla-object EC) 2)
    
73.       (SETQ E1 (ENTLAST))
    
74.       (VLA-OFFSET (vlax-ename->vla-object EC) -2)
    
75.       (SETQ E2 (ENTLAST))
    
76.       (VLA-PUT-COLOR(vlax-ename->vla-object EC)1)
    
77.       (VLA-PUT-Linetype(vlax-ename->vla-object EC)"CENTER2")
    
78.     )
    
79.   )
    
80.       )
    
81.       ((= code 3)      ; 鼠标左键
    
82.        (redraw)
    
83.        (setq loop nil)
    
84.       )
    
85.       ((= code 2)      ; 鼠标左键
    
86.        (redraw)
    
87.        (setq loop nil)
    
88.       )
    
89.     )
    
90.   )
    
91. )
    
92. 
    

(DEFUN C:TT (/ PT ZC ERR LOOP GR CODE PC L1 R PTT ANG P1 P2 P3 P4 EC E1<br />          E2)<br />   (SETQ Pt (GETPOINT "\n插入中心点"))<br />   (if (not pt)<br />     (vl-exit-with-value 0)<br />   )<br />   (setq zc (getreal "\n输入周长"))<br />   (FOREACH X (LIST "CENTER2" )<br />     (setq<br />       err (vl-catch-all-apply<br />       'vla-Load<br />       (list (vla-get-Linetypes<br />         (vla-get-ActiveDocument (vlax-get-acad-object))<br />       )<br />       X<br />       "acad.lin"<br />       )<br />     )<br />     )<br />     (if  (vl-catch-all-error-p err)<br />       (if (= (vl-catch-all-error-message err)<br />        "Automation Error. Duplicate record name"<br />     )<br />   (alert (strcat "A line type named '" X "' already exists."))<br />       )<br />     )<br />   )<br />   (setq  loop t)<br /> (WHILE LOOP<br />     (setq gr   (grread t 15 0)<br />     code (car gr)<br />     Pc   (cadr gr)<br />     )<br />     (cond<br />       ((= code 5)      ; 鼠标移动<br />   (redraw)<br />        (FOREACH  X (LIST EC E1 E2)<br />    (if X<br />      (entdel X)<br />    )<br />        )<br />   (setq l1 (distance pt pc)<br />         r   (/ (- zc l1 l1) 2 pi)<br />   )<br />   (IF (> R 4)<br />     (PROGN<br />       (SETQ ptt pc<br />       ANG (ANGLE PT PTT)<br />       p1  (polar pt (+ ANG (* 0.5 pi)) r)<br />       p2  (polar pt (+ ANG (* 1.5 pi)) r)<br />       p3  (polar ptt (+ ANG (* 1.5 pi)) r)<br />       p4  (polar ptt (+ ANG (* 0.5 pi)) r)<br />       ec  (entmakex  (LIST<br />           '(0 . "LWPOLYLINE")<br />           '(100 . "AcDbEntity")<br />           '(100 . "AcDbPolyline")<br />           '(90 . 5)<br />           '(70 . 1)<br />          <br />           (CONS 10 P1)<br />           '(42 . 0.0)<br />           (CONS 10 P4)<br />           '(42 . -1.0)<br />           (CONS 10 P3)<br />           '(42 . 0.0)<br />           (CONS 10 P2)<br />           '(42 . -1.0)<br />         )<br />           )<br />       )<br />       (VLA-OFFSET (vlax-ename->vla-object EC) 2)<br />       (SETQ E1 (ENTLAST))<br />       (VLA-OFFSET (vlax-ename->vla-object EC) -2)<br />       (SETQ E2 (ENTLAST))<br />       (VLA-PUT-COLOR(vlax-ename->vla-object EC)1)<br />       (VLA-PUT-Linetype(vlax-ename->vla-object EC)"CENTER2")<br />     )<br />   )<br />       )<br />       ((= code 3)      ; 鼠标左键<br />        (redraw)<br />        (setq loop nil)<br />       )<br />       ((= code 2)      ; 鼠标左键<br />        (redraw)<br />        (setq loop nil)<br />       )<br />     )<br />   )<br /> )<br /> <br />

其实，没啥用，lisp函数grread的缺陷，没办法支持捕捉，只能看着好玩。想要精准捕捉，还是要net或者c++

ssyfeng

看你这三个图红色中心线总长度不相等吧，动态拖动总长度可变？

戏男

ssyfeng 发表于 2023-6-16 22:04
看你这三个图红色中心线总长度不相等吧，动态拖动总长度可变？

总长度是相等的，就是用户输入的指定值长度，拖动不变，总长度等于输入值

liuhe

1.拖动描述不清楚，怎么拖动？夹点拖动？。2.长度保持不变，谁可以变？圆弧，直线？

戏男

liuhe 发表于 2023-6-17 08:17
1.拖动描述不清楚，怎么拖动？夹点拖动？。2.长度保持不变，谁可以变？圆弧，直线？

F:\5象这样，能以中心点变化更好

SdlFreeCAD

戏男 发表于 2023-6-17 09:02
象这样，能以中心点变化更好

老板提了这么多需求，直接联系我打包一站式为您解决了。

liunian0524

动态块，固定周长

戏男

SdlFreeCAD 发表于 2023-6-30 11:23
老板提了这么多需求，直接联系我打包一站式为您解决了。

SdlFreeCAD

戏男 发表于 2023-6-30 19:01

需要加QQ1005144760