将矩形更改为parallelo 乐筑天下 - Powered by Discuz! Archiver

JuniorNogueira 发表于 2022-7-5 15:35:59

将矩形更改为parallelo

我最近发了一个帖子，但没有成功。
下面的代码执行几个内部带有标签的矩形，因此出现了一些错误，如视频（Segunda\u LSP）中所述
我相信如果我把矩形变成平行四边形，问题就会解决
你觉得专家能帮我做什么？

为糟糕的英语道歉。

(defun c:Subdivide( / *error* bmakerec3vs vars vals ucsf p1 p2 p3 k n w h bnn )
(gc)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(defun *error* ( error )
(mapcar 'setvar vars vals)
(if ucsf
(command-s "_.UCS" "_P")
)
(vla-endundomark *doc*)
(cond
((not error))
((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
(1 (princ (strcat "\nERROR: " error)))
)
(princ)
)

(defun bmakerec3vs ( w h ts bn / p ss )
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(setq p (list (/ w 4.0) (/ h 2.0)))
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "00")
(ssadd (entlast) ss)
(vl-cmdf "_.BLOCK" bn '(0.0 0.0) ss)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(if (or (not (entlast)) (and (entlast) (not (ssmemb (entlast) ss))))
(progn
   (vl-cmdf "_.INSERT" bn '(0.0 0.0))
   (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
)
)

(vl-cmdf "_.BEDIT" bn)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.CHANGE" "_ALL" "" "_P" "_C" "3")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.BPARAMETER" "_V" p)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.-BVSTATE" "_N" "Edificações" "_C")
(vl-cmdf "_.-BVSTATE" "_D" "VisibilityState0")
(vl-cmdf "_.-BVSTATE" "_N" "Construções" "_H")
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "Construção")
(ssadd (entlast) ss)
(vl-cmdf "_.CHANGE" ss "" "_P" "_C" "2")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.-BVSTATE" "_N" "Terrenos" "_H")
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "Terreno")
(ssadd (entlast) ss)
(vl-cmdf "_.CHANGE" ss "" "_P" "_C" "4")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.-BVSTATE" "_N" "Comércios" "_H")
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "00")
(ssadd (entlast) ss)
(vl-cmdf "_.CHANGE" ss "" "_P" "_C" "5")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.BCLOSE")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(princ)
)

(or *k* (setq *k* 0))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(if (= 0 (getvar 'worlducs))
(progn
(vl-cmdf "_.UCS" "_W")
(setq ucsf t)
)
)
(setq vars '("cmdecho" "osmode"))
(setq vals (mapcar 'getvar vars))
(mapcar 'setvar vars '(0 0))
(if
(and
(setq p1 (getpoint "\nP1 <Início da Edificação>: "))
(setq p2 (getpoint p1 "\nP2 <Comprimento da Edificação>: "))
(setq p3 (getpoint p2 "\nP3 <Comprimento da Quadra>: "))
(or
   (not (equal (angle p1 p2) (angle p1 p3) 1e-4))
   (alert "\nPoints are all in a straight line.")
)
(not (initget 7))
(setq n (getint "\nQuantidade de Edificações ou Lotes: "))
(setq h (/ (distance p2 p3) n))
(setq w (distance p1 p2))
)
(progn
(bmakerec3vs w h (/ h 4.0) (setq bnn (strcat "rec" (itoa (setq *k* (1+ *k*))))))
(vl-cmdf "_.UCS" "_3P" p2 p1)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(setq k -1)
(repeat n
   (vl-cmdf "_.INSERT" bnn (list 0.0 (* h (setq k (1+ k)))))
   (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
)
(vl-cmdf "_.UCS" "_P")
)
)
(*error* nil)
)

(defun c:SD nil (c:Subdivide))
=

https://drive.google.com/file/d/1P2qgD-765O7z3dQtRXRtIHw-pvCT_DIP/view

https://drive.google.com/file/d/1Z914kQVntb1ZUoSUW-WlR9M0mw-cXp05/view

Grrr 发表于 2022-7-5 15:58:16

以下是我对3点romboid的尝试，它寻找距离最大的一对点，并将它们视为相反（对角线）：

(defun C:test ( / enamep SS pL )

(and
(setq enamep '((e) (eq 'ENAME (type e))))

(princ "\nSelect exactly 3 points: ") (setq SS (ssget '((0 . "POINT"))))
(or
(= 3 (length (setq pL (vl-remove-if-not 'enamep (mapcar 'cadr (ssnamex SS))))))
(prompt "\nYou didn't select 3 points!")
)
(setq pL (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) pL))
(setq pL
(apply
   ''(( a b c )
      (mapcar 'eval
      (cdar
         (vl-sort
            (mapcar ''((x) (cons (apply 'distance (mapcar 'eval (cdr x))) x))
            '((a b c)(b c a)(c a b))
            )
            ''((a b)(apply '< (mapcar 'car (list a b))))
         )
      )
      )
   )
   pL
)
); setq
(apply
''(( a b c / d )
   ; (grdraw a b 1)
   ; (grdraw b c 2)
   ; (grdraw c a 3)
   (setq d
      (inters
      b (polar b (angle a c) (distance a c))
      a (polar a (angle b c) (distance b c))
      nil
      )
   )
   (entmake
      (append
      '((0 . "LWPOLYLINE")(100 . "AcDbEntity")(100 . "AcDbPolyline")(90 . 4)(70 . 1))
      (mapcar 'cons '(10 10 10 10)
         (list
            a d b c
         )
      )
      )
   )
)
pL
); apply
); and

(princ)
); defun C:test

JuniorNogueira 发表于 2022-7-5 16:08:59

意图不是这样的，如果你看到视频，就会意识到LISP提供了三个点P1 P2和P3的矩形和数量，这些点与视频1到2有一个小的差异，我认为这正是因为它是一个矩形，我想取这些代码是为了只取矩形，然后放平行四边形，消除这种差异。

对不起，英语不好

marko_ribar 发表于 2022-7-5 16:19:47

如果你想让嵌套实体保持文本实体，你会如何处理矩形内的文本-使其倾斜-这是不可能的。。。我认为ab是这样的，如果你这样做（c:TXTEXP）=>REGION命令=>UNION命令=>CONVTOMESH命令；你可以得到倾斜适用的网格文本。。。但是，然后你必须使用矩阵变换来创建所需的形状动态块，并向其添加所需的视觉样式。。。然后，只有在块存储到内存中的最后，才应该应用ARRAY或CLASSICARRAY命令，或者通过（重复）循环中的INSERT命令数组来执行。。。这一切都是为了得到什么-块与网状文本-但为什么？？？你们已经有了我提供给你们的正常矩形和精细动态块的工作例程，其中嵌套了正常文本。。。带有平行四边形和倾斜网格文本的DWG在未来的编辑中，或者对于想要编辑该DWG的人来说，不是会更麻烦吗？？？

Grrr 发表于 2022-7-5 16:42:36

谢谢Rlx，
只是想试一试——对我来说这完全不切实际，但写起来很有趣。

页: [1]

乐筑天下's Archiver

将矩形更改为parallelo