Ahankhah 发表于 2022-7-6 09:41:00

如何将弧投影到当前

有人能帮我用lisp文件将圆弧和圆对象投影到视图中,并用椭圆替换它们吗?

Lee Mac 发表于 2022-7-6 09:53:48

也许这将为您指明正确的方向:
 
http://www.cadtutor.net/forum/showthread.php?55816-椭圆例程请求&p=378365&viewfull=1#post378365
 
简单的代码,但可能有帮助

Ahankhah 发表于 2022-7-6 10:12:20

非常感谢李,
你总是一个很大的帮助:哈哈。

David Bethel 发表于 2022-7-6 10:25:57

这是一个老项目。Autodesk培训部门的lsp。它写于80年代,在Autodesk将其来自地狱的许可证放在软件附带的任何代码的标题中之前。这是一个很好的学习/教学工具-大卫
项目。LSP

Lee Mac 发表于 2022-7-6 10:38:35

也许这是合适的:
 

(defun LM:ProjectArc ( e / el l r n )
(if (member (cdr (assoc 0 (setq el (entget e)))) '("ARC" "CIRCLE"))
   (entmakex
   (append
       (list
         (cons 0 "ELLIPSE")
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbEllipse")
       )
       (foreach x '(6 8 39 48 62 210)
         (if (assoc x el) (setq l (cons (assoc x el) l)) l)
       )
       (list
         (cons 10 (trans (cdr (assoc 10 el)) e 0))
         (cons 11
         (polar '(0. 0. 0.)
             (angle '(0. 0. 0.)
               (trans (getvar 'UCSXDIR) 0 (setq n (trans '(0. 0. 1.) 1 0 t)) t)
             )
             (setq r (cdr (assoc 40 el)))
         )
         )
         (cons 40 (abs (/ (* r (apply '+ (mapcar '* '(0. 0. 1.) n))) r)))
         (cons 41 (cond ( (cdr (assoc 50 el)) ) ( 0.0 )))
         (cons 42 (cond ( (cdr (assoc 51 el)) ) ( (* 2. pi) )))
       )
   )
   )
)
)

 

(defun c:test ( / e )
(if (setq e (car (entsel "\nSelect Arc or Circle: "))) (LM:ProjectArc e))
(princ)
)
 
代码将提供的在WCS中绘制的弧/圆投影到当前UCS

Ahankhah 发表于 2022-7-6 10:49:43

大卫·贝瑟尔,非常感谢。
李,再次谢谢你。
页: [1]
查看完整版本: 如何将弧投影到当前