Help with editing a lisp

Anonymous · ‎02-03-2018

Good afternoon guys, how are you?

Some time ago I made a post here in the forum help pedinfo to develop a program for me so @Anonymous Uhdend eveloped the program listed below for me, it was perfect !!! but I'd like to know how to make an improvement, I'd like you to do the following:
Initially, the program only draws the squares according to the indicated points, I want you to keep doing this, however,
I would like it to do the same, whenever the square was made in red color, the rectangle added a number "00" * ROMANS * * 2.69 * in the green color, when the rectangle was cyan, add the name "Terreno" * ROMANS * * 2.69 * in yellow color and when yellow is added the name "Construção" * ROMANS * * 2.69 * also in yellow. If the square changes the color from one to the other, the text also changes, for example: I made a square in the red color and then I changed to Cyan, I would like the text also to change.
The position of the text is striped in the image below.

I apologize for the message and for the poor English.
follows a photo,LISP and a .DWG.

(defun c:Subdivide ( / *error* vars vals p1 p2 p3 p4 ang n w)
(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)
(vla-endundomark *doc*)
(cond
((not error))
((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
(1 (princ (strcat "\nERROR: " error)))
)
(princ)
)
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(setq vars '("cmdecho" "osmode"))
(setq vals (mapcar 'getvar vars))
(mapcar 'setvar vars '(0 0))
(command "_.expert" (getvar "expert")) ;; dummy command
(and
(setq p1 (getpoint "\nP1: "))
(setq p2 (getpoint p1 "\nP2: "))
(setq p3 (getpoint p2 "\nP3: "))
(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 "\nEnter quantity of parcels to create: "))
(setq ang (angle p2 p3))
(setq w (/ (distance p2 p3) n))
(repeat n
(setq p3 (polar p2 ang w)
p4 (polar p1 ang w)
)
(vl-cmdf "_.pline" p2 p3 p4 p1 "_C")
(setq p2 p3 p1 p4)
)
)
(*error* nil)
)
(defun c:SD ()(c:Subdivide))

Anonymous · ‎02-03-2018

.DWG

john.uhden · ‎02-03-2018

It sounds like you want a reactor so that when you change a rectangle's color it gets a different label. Is that correct?

Or, maybe you change the recatngles to various colors and then you want a semi-automatic labeling command.

John F. Uhden

Anonymous · ‎02-03-2018

Exactly @john.uhden Has as?

john.uhden · ‎02-03-2018

I don't understand english very good. What does "Has as?" mean?
If you mean to ask if I already have the code you want, then sorry, but
no. Someone would have to write it once we figure out what you want.

John F. Uhden

Anonymous · ‎02-04-2018

No @john.uhden
and once again sorry for the pessimo English.
I did not mention you have the code, but to know that what I want is possible or impossible to do through .LSP.

Anonymous · ‎02-04-2018

Since the label inside the rectangle and independently a "Text" not as an attribute, to make the label inside the rectangle change according to the color of the rectangle, it does not seem to me something simple nor POSSIBLE.

marko_ribar · ‎02-04-2018

You could make routine insert dynamic blocks with various visibility states... Then when you change visibility state of single one, block changes both color and text... And of course it's preferable that text is not TEXT, but ATTRIBUTE...

Marko Ribar, d.i.a. (graduated engineer of architecture)

Anonymous · ‎02-04-2018

just how could it be done this way @marko_ribar?
trasnformalo in attribute does not help me, it would be inetessante if it was text.

marko_ribar · ‎02-04-2018

Actually it don't have to be ATTRIBUTE... It could be TEXT, but it must be nested inside dynamic block... Here is DWG with such block - I've named it RECTANGLE and it has 3 visibility states - you can switch between them by clicking upper right grip...

Marko Ribar, d.i.a. (graduated engineer of architecture)

Anonymous · ‎02-04-2018

I've attached a dwg with the correct way, this way it could also be, now as you can see in the screencast the above lisp creates rectangles based on p1 p2 and p3, how would I do for the rectangles already to come out with the dynamic block?

Anonymous · ‎02-04-2018

ah a misspelling in .dwg, it follows attachment with the correct one.

marko_ribar · ‎02-04-2018

(defun c:Subdivide ( / *error* bmakerec3vs vars vals ucsf p1 p2 p3 k n w h bn )

  (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" "_non" '(0.0 0.0) "_non" (list w h))
    (ssadd (entlast) ss)
    (setq p (list (/ w 4.0) (/ h 2.0)))
    (vl-cmdf "_.TEXT" "_J" "_ML" "_non" p ts "" "red")
    (ssadd (entlast) ss)
    (vl-cmdf "_.BLOCK" bn "_non" '(0.0 0.0) ss "")
    (if (or (not (entlast)) (and (entlast) (not (ssmemb (entlast) ss))))
      (progn
        (vl-cmdf "_.INSERT" bn "_non" '(0.0 0.0))
        (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
      )
    )
    (vl-cmdf "_.BEDIT" bn "")
    (vl-cmdf "_.CHANGE" "_ALL" "" "_P" "_C" "1" "")
    (vl-cmdf "_.BPARAMETER" "_V" "_non" p 1 "")
    (vl-cmdf "_.-BVSTATE" "_N" "red" "_C")
    (vl-cmdf "_.-BVSTATE" "_D" "VisibilityState0")
    (vl-cmdf "_.-BVSTATE" "_N" "yellow" "_H")
    (setq ss (ssadd))
    (vl-cmdf "_.RECTANGLE" "_non" '(0.0 0.0) "_non" (list w h))
    (ssadd (entlast) ss)
    (vl-cmdf "_.TEXT" "_J" "_ML" "_non" p ts "" "yellow")
    (ssadd (entlast) ss)
    (vl-cmdf "_.CHANGE" ss "" "_P" "_C" "2" "")
    (vl-cmdf "_.-BVSTATE" "_N" "green" "_H")
    (setq ss (ssadd))
    (vl-cmdf "_.RECTANGLE" "_non" '(0.0 0.0) "_non" (list w h))
    (ssadd (entlast) ss)
    (vl-cmdf "_.TEXT" "_J" "_ML" "_non" p ts "" "green")
    (ssadd (entlast) ss)
    (vl-cmdf "_.CHANGE" ss "" "_P" "_C" "3" "")
    (vl-cmdf "_.BCLOSE" "")
    (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: "))
      (setq p2 (getpoint p1 "\nP2: "))
      (setq p3 (getpoint p2 "\nP3: "))
      (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 "\nEnter quantity of parcels to create: "))
      (setq h (/ (distance p2 p3) n))
      (setq w (distance p1 p2))
    )
    (progn
      (bmakerec3vs w h (/ h 4.0) (setq bn (strcat "rec" (itoa (setq *k* (1+ *k*)))))) ;;; Specify different textsize instead of (/ h 4.0) and your unique name for block instead of "rec" (you may leave it as new block names will be created according to incrementation of global variable *k*
      (entdel (entlast))
      (vl-cmdf "_.UCS" "_3P" "_non" p2 "_non" p1 "_non" p3)
      (setq k -1)
      (repeat n
        (vl-cmdf "_.INSERT" bn "" "_non" (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))

Edit sub function (bmakerec3vs) according to your color and text specifications needs...

HTH., M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

Anonymous · ‎02-04-2018

I just tested here, I think ah some problem, when I run the command it goes well up to the amount of plots, then enters the block editor, causing lock, and does not execute the command, can you tell me the reason?

marko_ribar · ‎02-04-2018

Ok, I've found mistakes...

Test it now :

(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 "" "red")
    (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" "1")
    (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
    (vl-cmdf "_.BPARAMETER" "_V" p)
    (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
    (vl-cmdf "_.-BVSTATE" "_N" "red" "_C")
    (vl-cmdf "_.-BVSTATE" "_D" "VisibilityState0")
    (vl-cmdf "_.-BVSTATE" "_N" "yellow" "_H")
    (setq ss (ssadd))
    (vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
    (ssadd (entlast) ss)
    (vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "yellow")
    (ssadd (entlast) ss)
    (vl-cmdf "_.CHANGE" ss "" "_P" "_C" "2")
    (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
    (vl-cmdf "_.-BVSTATE" "_N" "green" "_H")
    (setq ss (ssadd))
    (vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
    (ssadd (entlast) ss)
    (vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "green")
    (ssadd (entlast) ss)
    (vl-cmdf "_.CHANGE" ss "" "_P" "_C" "3")
    (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: "))
      (setq p2 (getpoint p1 "\nP2: "))
      (setq p3 (getpoint p2 "\nP3: "))
      (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 "\nEnter quantity of parcels to create: "))
      (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*)))))) ;;; Specify different textsize instead of (/ h 4.0) and your unique name for block instead of "rec" (you may leave it as new block names will be created according to incrementation of global variable *k*)
      (entdel (entlast))
      (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))

HTH., M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

Anonymous · ‎02-04-2018

Hi @marko_ribar
It was perfect !!!!!, you really were my salvation, I only have to thank you, but I had two doubts.

1st, this screencast problem would have to solve?
2nd case one day I want to add the color blue, how would I do it?

Screencast will be displayed here after you click Post.

136da0f8-b82b-454b-9891-3a65f4f74089

Anonymous · ‎02-04-2018

marko_ribar · ‎02-04-2018

1st :

rectangle shape is always unique - 90 degrees between all edges... For screencast solution, you have to account for the fact that p1 is always bottom right point of rectangles and p2 bottom left point... So the order you pick point is essential for correct construction of array...

2nd :

for new color - visibility state, you have to edit main sub function - just copy+paste few lines from the bottom of sub, just before BCLOSE command... Of course you have to change color number and text string...

Marko Ribar, d.i.a. (graduated engineer of architecture)

Community

Help with editing a lisp

Help with editing a lisp

Help with editing a lisp