戏男 发表于 2023-6-16 15:23

这样的圆拖拉变形

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

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

liuhe 发表于 2023-6-16 15:23

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

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

ssyfeng 发表于 2023-6-16 22:04

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

戏男 发表于 2023-6-17 08:03

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

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

liuhe 发表于 2023-6-17 08:17

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

戏男 发表于 2023-6-17 09:02

本帖最后由 戏男 于 2023-6-17 09:07 编辑

liuhe 发表于 2023-6-17 08:17
1.拖动描述不清楚，怎么拖动？夹点拖动？。2.长度保持不变，谁可以变？圆弧，直线？
F:\5象这样，能以中心点变化更好

SdlFreeCAD 发表于 2023-6-30 11:23

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

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

liunian0524 发表于 2023-6-30 13:23

动态块，固定周长

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

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

:lol:lol:lol:lol

SdlFreeCAD 发表于 2023-7-1 00:15

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


需要加QQ1005144760
页: [1] 2
查看完整版本: 这样的圆拖拉变形