求一个画弧形投影线的工具

xiehaoing · 发表于 2022-2-16 10:02

求一个画弧形投影线的工具
类似这样的
选中平面的弧形，然后可以自动实现立面正投影，并添加这种投影线，最好能给个源码。谢谢了

xyp1964 · 发表于 2022-2-16 10:02

(defun c:tt ()
(defun SSelEntnext (en / ss)
(setq ss (ssadd))
(while (setq en (entnext en)) (ssadd en ss))
ss
)
(setq nn (getint "\n等分数量: "))
(or nn (setq nn 21))
(setq s1 (car (entsel "\n选择曲线: ")))
(setvar "osmode" 0)
(setq s0 (entlast))
(command "divide" s1 nn)
(setq ss (SSelEntnext s0)
p1 (vlax-curve-getEndPoint s1)
i -1
ptn '()
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ptn (cons (cdr (assoc 10 (entget s1))) ptn))
)
(command "erase" ss "")
(setq ptn (mapcar '(lambda (x) (list (car x) (cadr p1))) ptn)
ptn1 (mapcar '(lambda (x) (list (car x) (- (cadr x) 1000))) ptn)
)
(mapcar '(lambda (x y) (command "line" x y "")) ptn ptn1)
(command "line" (car ptn) (last ptn) "")
(command "line" (car ptn1) (last ptn1) "")
(princ)
)

(defun c:tt () 
  (defun SSelEntnext (en / ss) 
    (setq ss (ssadd)) 
    (while (setq en (entnext en)) (ssadd en ss)) 
    ss 
  ) 
  (setq nn (getint "\n等分数量: ")) 
  (or nn (setq nn 21)) 
  (setq s1 (car (entsel "\n选择曲线: "))) 
  (setvar "osmode" 0) 
  (setq s0 (entlast)) 
  (command "divide" s1 nn) 
  (setq        ss  (SSelEntnext s0) 
        p1  (vlax-curve-getEndPoint s1) 
        i   -1 
        ptn '() 
  ) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (setq ptn (cons (cdr (assoc 10 (entget s1))) ptn)) 
  ) 
  (command "erase" ss "") 
  (setq        ptn  (mapcar '(lambda (x) (list (car x) (cadr p1))) ptn) 
        ptn1 (mapcar '(lambda (x) (list (car x) (- (cadr x) 1000))) ptn) 
  ) 
  (mapcar '(lambda (x y) (command "line" x y "")) ptn ptn1) 
  (command "line" (car ptn) (last ptn) "") 
  (command "line" (car ptn1) (last ptn1) "") 
  (princ) 
)

夏生生 · 发表于 2022-2-16 11:01

需求不是很详细，粗略写了一个，您可以试试

(defun c:test1 (/ dis en lst n pause pt1 pt2 pt3 pt4 ss)
(defun G-pertoline (pt pt1 pt2 / norm)
(setq norm (mapcar '- pt2 pt1)
pt1 (trans pt1 0 norm)
pt (trans pt 0 norm)
)
(trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0)
)
(setq en (vlax-ename->vla-object (car (entsel "\n选:")))
n (getint "\n等分数")
ss (ssadd)
dis (/ (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
n
)
)
(repeat (1+ n)
(setq
lst (cons (vlax-curve-getpointatdist en (* n dis)) lst)
n (1- n)
)
)
(vla-getboundingbox en 'pt1 'pt2)
(setq pt1 (vlax-safearray->list pt1)
pt2 (vlax-safearray->list pt2)
pt3 (list (car pt2) (cadr pt1))
pt4 (list (car pt1) (cadr pt2))
)
(setq ss (ssadd (entmakex (list '(0 . "line")
(cons 10 pt1)
(cons 11 pt3)
)
)
ss
)
ss (ssadd (entmakex (list '(0 . "line")
(cons 10 pt4)
(cons 11 pt2)
)
)
ss
)
)
(foreach n lst
(setq ss (ssadd (entmakex (list '(0 . "line")
(cons 10 (G-pertoline n pt1 pt3))
(cons 11 (G-pertoline n pt2 pt4))
)
)
ss
)
)
)
(command "move" ss "" pt4 pt1)
)

(defun c:test1 (/ dis en lst n pause pt1 pt2 pt3 pt4 ss) 
  (defun G-pertoline (pt pt1 pt2 / norm) 
    (setq norm (mapcar '- pt2 pt1) 
          pt1  (trans pt1 0 norm) 
          pt   (trans pt 0 norm) 
          ) 
    (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0) 
    ) 
  (setq        en  (vlax-ename->vla-object (car (entsel "\n选:"))) 
        n   (getint "\n等分数") 
        ss  (ssadd) 
        dis (/ (vlax-curve-getdistatparam en (vlax-curve-getendparam en)) 
               n 
               ) 
        ) 
  (repeat (1+ n) 
    (setq 
      lst (cons (vlax-curve-getpointatdist en (* n dis)) lst) 
      n          (1- n) 
      ) 
    ) 
  (vla-getboundingbox en 'pt1 'pt2) 
  (setq        pt1 (vlax-safearray->list pt1) 
        pt2 (vlax-safearray->list pt2) 
        pt3 (list (car pt2) (cadr pt1)) 
        pt4 (list (car pt1) (cadr pt2)) 
        ) 
  (setq        ss (ssadd (entmakex (list '(0 . "line") 
                                  (cons 10 pt1) 
                                  (cons 11 pt3) 
                                  ) 
                            ) 
                  ss 
                  ) 
        ss (ssadd (entmakex (list '(0 . "line") 
                                  (cons 10 pt4) 
                                  (cons 11 pt2) 
                                  ) 
                            ) 
                  ss 
                  ) 
        ) 
  (foreach n lst 
    (setq ss (ssadd (entmakex (list '(0 . "line") 
                                    (cons 10 (G-pertoline n pt1 pt3)) 
                                    (cons 11 (G-pertoline n pt2 pt4)) 
                                    ) 
                              ) 
                    ss 
                    ) 
          ) 
    ) 
  (command "move" ss "" pt4 pt1) 
  )

xiehaoing · 发表于 2022-2-16 15:43

夏生生发表于 2022-2-16 11:01
需求不是很详细，粗略写了一个，您可以试试

你好报错命令: ; 错误: 输入的字符串有缺陷。。不知道什么原因

xj6019 · 发表于 2022-2-16 16:31

我测试的时候没出现呢但是效果好像有点不太一样那种渐变的感觉没有不过渐变好像挺费劲

cq4920 · 发表于 2022-2-16 17:41

本帖最后由 cq4920 于 2022-2-16 18:06 编辑

你那个透视关系不太对哟

最开始想到的是批量线上加点然后由点画线！但是用的比较少，也就用了个笨方法
1.圆弧转多段线
2.QDIM 标注
3.炸开标注删除多余部分.

xiehaoing · 发表于 2022-2-17 10:34

cq4920 发表于 2022-2-16 17:41
你那个透视关系不太对哟

最开始想到的是批量线上加点然后由点画线！但是用的比较少，也就用了个笨 ...

谢谢，就是这个意思

czb203 · 发表于 2022-2-17 20:27

他牛逼了，非常感谢

夏生生 · 发表于 2022-2-17 21:14

xiehaoing 发表于 2022-2-16 15:43
你好报错命令: ; 错误: 输入的字符串有缺陷。。不知道什么原因

代码没拷贝全吧

夏生生 · 发表于 2022-2-17 21:19

xj6019 发表于 2022-2-16 16:31
我测试的时候没出现呢但是效果好像有点不太一样那种渐变的感觉没有不过渐变好像挺费劲

按他那种渐变确实费劲，要算斜率

账号		自动登录	找回密码
密码			注册

[提问] 求一个画弧形投影线的工具

最佳答案

评分

本帖子中包含更多资源