whosa 发表于 2022-7-5 16:45:50

“3D”矩形

你好
 
我想在三维实体内制作矩形（或闭合多段线）。
 
现在我使用：
 
Ucs+面+矩形的第一个角点和矩形的第二个角点。
 
我想这样做的Lisp程序。
 
类似于：
 
第一次单击：第一个角点
 
第二次单击：第二个角点
 
绘制一个带有两点的矩形，这意味着矩形的黄色边缘必须平行于z轴。
 

 
如果有人能帮我，那太好了。
 
谢谢

BIGAL 发表于 2022-7-5 17:01:02

UCS X 90可能

Roy_043 发表于 2022-7-5 17:04:10

尝试：
(defun c:3DRect ( / doc firstP normal pt1 pt2 pt3 pt4)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc) ; End open undo group.
(vla-startundomark doc)
(if
   (and
   (setq pt1 (getpoint "\nFirst corner: "))
   (setq pt3 (getpoint pt1 "\nOther corner: "))
   (setq normal
       (mapcar '(lambda (a b) (if (equal a b 1e- 1 0)) pt1 pt3)
   )
   (= 1 (apply '+ normal))
   )
   (progn
   (setq pt2
       (mapcar
         '(lambda (n a b)
         (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt1
         pt3
       )
   )
   (setq pt4
       (mapcar
         '(lambda (n a b)
         (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt3
         pt1
       )
   )
   (setq normal (trans normal 1 0 T))
   (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 1 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 1 normal))
         (cons 10 (trans pt2 1 normal))
         (cons 10 (trans pt3 1 normal))
         (cons 10 (trans pt4 1 normal))
         (cons 210 normal)
       )
   )
   )
)
(vla-endundomark doc)
(princ)
)

whosa 发表于 2022-7-5 17:13:26

 
非常感谢，我试过了。它部分起作用。我尝试在很多情况下使用，但有些时间不起作用。
 
附上你可以找到的测试。在三种情况下（红色多段线），此lisp不起作用。也许我犯了一些错误。
测验图纸

marko_ribar 发表于 2022-7-5 17:23:16

在这里，我纠正了罗伊的代码，虽然有些不同，但逻辑是相同的。。。
 

(defun c:3DRect ( / v^v unit doc normal pt1 pt2 pt3 pt4 )

(vl-load-com)

(defun v^v ( u v )
   (list
   (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
   (- (* (caddr u) (car v)) (* (car u) (caddr v)))
   (- (* (car u) (cadr v)) (* (cadr u) (car v)))
   )
)

(defun unit ( v )
   (if (not (equal v '(0.0 0.0 0.0) 1e-)
   (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
   )
)

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc) ; End open undo group.
(vla-startundomark doc)
(if
   (and
   (setq pt1 (trans (getpoint "\nFirst corner : ") 1 0))
   (setq pt3 (trans (getpoint (trans pt1 0 1) "\nOther corner : ") 1 0))
   (setq normal (unit (v^v '(0.0 0.0 1.0) (mapcar '- pt3 pt1))))
   )
   (progn
   (setq pt2 (inters pt1 (mapcar '+ pt1 (v^v normal (append (mapcar '+ '(0.0 0.0) (mapcar '- pt3 pt1)) (list 0.0)))) pt3 (mapcar '+ pt3 (append (mapcar '+ '(0.0 0.0) (mapcar '- pt1 pt3)) (list 0.0))) nil))
   (setq pt4 (inters pt3 (mapcar '+ pt3 (v^v normal (append (mapcar '+ '(0.0 0.0) (mapcar '- pt1 pt3)) (list 0.0)))) pt1 (mapcar '+ pt1 (append (mapcar '+ '(0.0 0.0) (mapcar '- pt3 pt1)) (list 0.0))) nil))
   (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 0 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 0 normal))
         (cons 10 (trans pt2 0 normal))
         (cons 10 (trans pt3 0 normal))
         (cons 10 (trans pt4 0 normal))
         (cons 210 normal)
       )
   )
   )
)
(vla-endundomark doc)
(princ)
)

 
M、 R。

Roy_043 发表于 2022-7-5 17:36:02

我对这个问题的解释与Marko的不同。我的代码假设矩形必须与当前UCS的X、Y或Z平面平行。Marko的解决方案假设矩形的两侧必须平行于WCS的Z轴。

Roy_043 发表于 2022-7-5 17:40:23

@马尔科：
为什么不这样计算pt2和pt4
(setq pt2 (list (car pt1) (cadr pt1) (caddr pt3)))
(setq pt4 (list (car pt3) (cadr pt3) (caddr pt1)))

marko_ribar 发表于 2022-7-5 17:46:12

 
是的，就这么简单。。。我对代码进行了过度编程，但结果是一样的——总是有很多方法可以剥猫的皮。。。
页: [1]
查看完整版本: “3D”矩形