Ceiling grid lisp

[dani_cs]

Hello,

I've been looking for this lisp but I couldn't find some similar in the forum. 

So, I need a routine that ask me the boundary selecting 2 opposite corners, then the distance between titles (WxH) and finally the routine will draw the specific ceiling grid. But also, I would like that the routine will name all titles with a middle center mtext in all titles ( incrementing numbers for W and incrementing letters for H for example). If it is possible the code, I would like to know how to change the code for the names (one day I need incrementing numbers for W and incrementing letters for H and other day I need incrementing numbers for H and incrementing letters for W)

I'm attaching a drawing.

Best regards,

Daniel 

[DannyNL]

Why don't you just use ARRAY to copy a tile and text?

The only thing really needed is a lisp to change and increment the text in the tiles, right?

[dani_cs]

Hello,  DannyNL

Good idea. I know an incrementing number command (1,2,3....) but not incremental letter command (A,B,C,AA,AB,AC...)

do you know any?

best regards,

daniel

[Sea-Haven]

Using the CHR function you can use numbers rather than characters from memory A=65 so AA = 65 65 you could write a routine to work this out would allow up to ZZ in a two character array arrangement

(while
(setq x (getint "Enter a number no error check try 65" ))
(alert (strcat (chr x) " = " (rtos x 2 0)))
)

[CADaSchtroumpf]

To incremental letter and/or numeric command, you can try for exemple this:

(defun inc_txt (Txt / Boucle Decalage Val_Txt)
  (setq Boucle 1
  Val_txt ""
  )
  (while (<= Boucle (strlen Txt))
    (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle)))
    (if (not Decalage)
      (setq Ascii_Txt (1+ Ascii_Txt))
    )
    (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123))
      (setq
  Ascii_Txt
   (cond
     ((= Ascii_Txt 58) 48)
     ((= Ascii_Txt 91) 65)
     ((= Ascii_Txt 123) 97)
   )
  Decalage nil
      )
      (setq Decalage T)
    )
    (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt))
    (setq Boucle (1+ Boucle))
  )
  (if (not Decalage)
    (setq Val_Txt (strcat (cond ((< Ascii_Txt 58) "0")
        ((< Ascii_Txt 91) "A")
        ((< Ascii_Txt 123) "a")
        )
        Val_Txt
      )
    )
  )
  Val_Txt
)

return:

Command: (inc_txt "R66")
"R67"

Command: (inc_txt "AB6")
"AB7"

Command: (inc_txt "AZ6")
"AZ7"

Command: (inc_txt "AZB6")
"AZB7"

Command: (inc_txt "AZB")
"AZC"

Command: (inc_txt "AZZ")
"BAA"

etc...

[dani_cs]

hello,

I dont know how to write a lsp routine.

best regards,

daniel.

[dani_cs]

Hello CADaStroumph,

I cant run it.

How can I do it?

Best regards,

daniel.

[ronjonp]

Here's a quick one to increment your text ( A B C AA BB CC ) etc.

(defun c:daisyinc (/ a b c l p s x)
  (cond
    ((and (setq s (ssget ":L" '((0 . "text,mtext"))))
	  (setq p (getpoint "\nPick a point to start numbering from: "))
     )
     (setq a 1)
     (setq b 65)
     (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
     (setq l (mapcar '(lambda (x) (list x (cdr (assoc 10 (entget x))))) l))
     (while (setq l (vl-sort l '(lambda (r j) (< (distance p (cadr r)) (distance p (cadr j))))))
       (setq x (car l))
       (setq p (cadr x))
       (cond ((= b 91) (setq b 65) (setq a (1+ a))))
       (setq c "")
       (repeat a (setq c (strcat c (chr b))))
       (setq b (1+ b))
       (entmod (append (entget (car x)) (list (cons 1 c))))
       (setq l (cdr l))
     )
    )
  )
  (princ)
)

[dani_cs]

Hello rperez,

It works a little. When I select the letters, the lisp increment the text but it doesnt overwrite the previous letter. For example I have A A A A A and I want A B C D E, but the lisp make AA AB AC AD AE

I would like to overwrite the previous letter and when I reach to Z then it will start AA AB.

Thanks, best regards,

Daniel

[CADaSchtroumpf]

---

@dani_cs  a écrit :

Hello CADaStroumph,

I cant run it.

How can I do it?

Best regards,

daniel.

---

Hi,

Is a function, you can use it in command line for testing (see my return)

or you can integrate it in command function, for exemple this:

(defun c:inctextsel ( / js dxf_ent)
  (while (setq js (ssget "_+.:E:S" '((0 . "*TEXT"))))
    (setq dxf_ent (entget (ssname js 0)))
    (entmod (subst (cons 1 (inc_txt (cdr (assoc 1 dxf_ent)))) (assoc 1 dxf_ent) dxf_ent))
  )
  (prin1)
)

[ronjonp]

Seems to work here...

[dani_cs]

Hello,

Yes, it works perfectly when it is text, but when it is mtext it doesnt overwrite the previous letter.

However, Thanks! it's a solution.

best regards,

daniel.

[ronjonp · Accepted solution]

 I see .. try this version:

(defun c:daisyinc (/ a b c l p s x)
  (cond
    ((and (setq s (ssget ":L" '((0 . "text,mtext"))))
	  (setq p (getpoint "\nPick a point to start numbering from: "))
     )
     (setq a 1)
     (setq b 65)
     (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
     (setq l (mapcar '(lambda (x) (list x (cdr (assoc 10 (entget x))))) l))
     (while (setq l (vl-sort l '(lambda (r j) (< (distance p (cadr r)) (distance p (cadr j))))))
       (setq x (car l))
       (setq p (cadr x))
       (cond ((= b 91) (setq b 65) (setq a (1+ a))))
       (setq c "")
       (repeat a (setq c (strcat c (chr b))))
       (setq b (1+ b))
       ;; (entmod (append (entget (car x)) (list (cons 1 c))))
       (entmod (subst (cons 1 c) (assoc 1 (entget (car x))) (entget (car x))))
       (setq l (cdr l))
     )
    )
  )
  (princ)
)

[dani_cs]

Hello rperez,

Thanks a lot. Now it works with text and mtext. Just one thing, when it starts with 2 letters, the routine makes this: AA BB CC DD EE.... it could be AA AB AC AD AE....BA BB BC BD..... CA CB CC CD....

Best regards,

Daniel.

[ronjonp · Accepted solution]

Try this:

(defun c:daisyinc (/ a b c l p s)
  (cond
    ((and (setq s (ssget ":L" '((0 . "text,mtext"))))
	  (setq p (getpoint "\nPick a point to start numbering from: "))
     )
     (setq a 0)
     (setq b 65)
     (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
     (setq l (mapcar '(lambda (x) (list x (cdr (assoc 10 (entget x))))) l))
     (while (setq l (vl-sort l '(lambda (r j) (< (distance p (cadr r)) (distance p (cadr j))))))
       (setq x (car l))
       (setq p (cadr x))
       (setq c (strcat (chr a) (chr b)))
       (cond ((= b 91) (setq b 65) (or (and (= a 0) (setq a 65)) (setq a (1+ a)))))
       (entmod (subst (cons 1 c) (assoc 1 (entget (car x))) (entget (car x))))
       (setq b (1+ b))
       (setq l (cdr l))
     )
    )
  )
  (princ)
)

[dani_cs]

hello,

thanks, it works!

best regards,

Daniel.