Change rectangles to parallelograms.

[JuniorNogueira]

I posted a post recently but I did not succeed.

the code below, performs several rectangles with a label inside, thus it presents some errors, described in the video (Segunda_LSP)

I believe that if I change from rectangles to parallelograms the problem will be solved

What do you think some expert can help me with?

 

 

Apologies for the bad English.

 

(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]

Heres my attempt for a 3 point romboid, which looks for the pair of points with the largest distance and considers them as opposite (diagonal) :

 

(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]

The intention is not this, if you get to see the videos will realize that the LISP provide me rectangles from three points P1 P2 and P3 and QUANTITY, the points give a small difference from video 1 to 2, this difference I think which is precisely because it is a rectangle, I wanted to take these codes is to change only to take out the rectangles and put parallelograms, to extinguish that difference.

 

sorry for the bad english

[marko_ribar]

What will you do with texts inside rectangles - skew them - that's not possible if you want nested entity to remain TEXT entity... I thought ab this and maybe if you do (c:TXTEXP) => REGION command => UNION command => CONVTOMESH command; you could get meshed text which is skew applicable... But then you have to use matrix transformations to create desired shaped dynamic block and add desired visual styles to it... Then only at the end when block is stored in memory, you should apply ARRAY or CLASSICARRAY commands or do it through array of INSERT commands in (repeat) loop... This all to get what - blocks with meshed TEXTS - but why??? You have already working routine I provided to you with normal rectangles and fine dynamic blocks with normal TEXTs nested into them... Wouldn't DWG with parallelograms and skewed meshed TEXTS be more cumbersome for editing in future or for maybe someone who wants to edit that DWG???

[rlx]

Heres my attempt for a 3 point romboid, which looks for the pair of points with the largest distance and considers them as opposite (diagonal) :

 

(defun C:test ( / enamep SS pL )
 

 

nice code Grrr!

[Grrr]

Thanks Rlx,

Just wanted to give it a shot - for me its totally impractical, but fun to write.