Topic: LWPoly into block points limited..

[ScottMC]

Just want to ease the creation @ [ line: 6 ] not without using
 the pauses style and..
 also a pointer to avoid block name conflict/duplicate when
 creating. Also m any other suggestions Greatly Appreciated!

Code: [Select]

(defun c:pbn ( / nbn nob tlp) ;; makes poly block without 'name proofer'
  (princ "\n LWPolyline -> Block <name>..")
  (setvar 'cmdecho 0)
  (setq nob (getstring "\n Name: "))
(setq nbn (getpoint "\n First Point <last is base>"))
  (command "_.pline" nbn "\\" "\\" "\\" "\\")
      ;; proof/correct/re-loop for usable block name <<<<<<<<<
      (setq tlp (getvar 'lastpoint))
       (command "-block" nob tlp "_L" "")
       (command "-insert" nob tlp 1 "" "")
  (setvar 'cmdecho 1)
(princ)
)


[Tharwat]

Hi,
Give this a shot Scott and let me know.

Code - Auto/Visual Lisp: [Select]

1. (defun c:Test (/ bkn mov inc grp pt1 pt2 pts one)
2.   ;; Tharwat Al Choufi - 13.Mar.2022    ;;
3.   (princ "\nCreate LWPolyline with four coordinates then convert to Block .....")
4.   (while
5.     (and
6.       (/= "" (setq bkn (getstring "\nName of Block < enter to exit > : ")))
7.       (cond
8.         ((tblsearch "BLOCK" bkn)
9.          (alert
10.            (strcat "Block name < " bkn " > is already used. Try again")
11.          )
12.          t
13.         )
14.         (t (setq mov t) nil)
15.       )
16.     )
17.   )
18.   (and mov
19.     (setq inc -1
20.           pt1 (getpoint "\nSpecify 1st Point < last is base > :")
21.     )
22.     (setq grp '("2nd" "3rd" "4th" "5th")
23.           pts (cons pt1 pts)
24.     )
25.     (while (and (setq pt2 (getpoint (strcat "\nSpecify < "
26.                                             (nth (setq inc (1+ inc)) grp)
27.                                             " > point < enter to exit > : "
28.                                     )
29.                           )
30.                 )
31.                 (setq pts (cons pt2 pts))
32.                 (/= inc 3)
33.                 (setq one (car pts))
34.            )
35.       (foreach pnt (cdr pts)
36.         (grdraw one pnt 2 2)
37.         (setq one pnt)
38.       )
39.     )
40.     (= (length pts) 5)
41.     (entmake (list '(0 . "BLOCK")
42.                    (cons 10 (trans pt2 1 0))
43.                    (cons 2 bkn)
44.                    '(70 . 0)
45.              )
46.     )
47.     (entmake
48.       (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 5) (70 . 0))
49.               (mapcar (function (lambda (p) (cons 10 p))) pts)
50.       )
51.     )
52.     (entmake '((0 . "ENDBLK")))
53.     (entmake (list '(0 . "INSERT")
54.                    (cons 2 bkn)
55.                    (cons 10 (trans pt2 1 0))
56.              )
57.     )
58.   )
59.   (redraw)
60.   (princ)
61. )
62.  

[ScottMC]

 *NICE* So far, just gonna use the while to avoid the existing-block conflict Thanks-much!
Oops now, and really nothing important is:
allowing typical polyline construction and finishing cleanly.
Still can see this useful as-is. The ones I'll probably use are
 the circle and rectang of the same which work so well.

Code: [Select]

(defun c:rbn ( / nbn nob tlp) ;; makes rect block without 'name proofer'
  (princ "\n Rectangle -> Block w/Rotation <name>..")
  (setvar 'cmdecho 0)
  (setq nbn (getpoint "\n Corner Point <second is base>"))
  (command "_.rectang" nbn "\\")
  ;(setq nob (getstring "\n Name: "))
(while
(and
(/= "" (setq nob (getstring "\nName of Block < enter to exit > : ")))
(cond
((tblsearch "BLOCK" nob)
(alert
(strcat "Block name < " nob " > is already used. Try again")
)
t
)
(t (setq mov t) nil)
)
)
)
      ;; proof/correct/re-loop for usable block name <<<<<<<<<
      (setq tlp (getvar 'lastpoint))
       (command "-block" nob tlp "_L" "")
       (command "-insert" nob tlp 1 "")
  (setvar 'cmdecho 1)
(princ)
)


[BIGAL]

This is a point label bubble or Square posted as it has the entmake a square or circle and turn it into a Block. You would just replace the portion where it uses a defined square size with select points can add more than 4.

Code: [Select]

; bubble pt num
; BY ALAN H AUG 2014

(defun make_circle ()
  (entmake (list (cons 0 "CIRCLE")
(cons 8 "0")
(cons 10 (list 0 0 0))
(cons 40 3.25) ; rad
(cons 210 (list 0 0 1))
(cons 62 256)
(cons 39 0)
(cons 6 "BYLAYER")
   )
  )
) ; DEFUN

(defun make_sq ()
  (setq vertexList
  (list
  (list -3.25 -3.25 0.)
  (list 3.25 -3.25 0.)
  (list 3.25 3.25 0.)
  (list -3.25 3.25 0.)
  ))
  (entmake
    (append
    (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    (cons 90 (length vertexList))
    (cons 70 1) ; 1 closed : 0 open
    (cons 8 "0")
    (cons 38 0.0)
    (cons 210 (list 0.0 0.0 1.0))
    )
    (mapcar '(lambda (pt) (cons 10 pt)) vertexList)
    )
  )
) ; defun

(defun Make_bubble ( )

  (entmake (list (cons 0 "BLOCK")
    (cons 2 Blkname)
    (cons 70 2)
    (cons 10 (list 0 0 0))
    (CONS 8 "0")
  ))

  (if (= resp "Circle")
  (make_circle)
  (make_sq)
  )

  (entmake (list (cons 0 "ATTDEF")
       (cons 8 "0")
       (cons 10 (list 0 0 0))
       (cons 1 "1") ; default value
       (cons 2 blkname) ; nblock name
       (cons 3 "Ptnum") ; tag name
       (cons 6 "BYLAYER")
       (cons 7 "STANDARD") ;text style
       (cons 8 "0") ; layer
       (cons 11 (list 0.0 0.0 0.0)) ; text insert pt
       (cons 39 0)
       (cons 40 3.5) ; text height
       (cons 41 1) ; X scale
       (cons 50 0) ; Text rotation
       (cons 51 0) ; Oblique angle
       (cons 62 256) ; by layer color
       (cons 70 0)
       (cons 71 0) ;Text gen flag
       (cons 72 1) ; Text Justify hor 1 center
       (cons 73 0) ; field length
       (cons 74 2) ; Text Justify ver 2 center
       (cons 210 (list 0 0 1))
  ))

  (entmake (list (cons 0 "ENDBLK")))
  (princ)
 
)

(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= ahbut nil)(setq ahbut 1))



(setq resp (ah:butts ahbut "v"  '("Circle  or square " "Circle" "Square")))

(if  (= resp "Circle")
  (setq blkname "SETOUT_POINT_NO")
  (setq blkname "SETOUT_POINT_NOSQ")
)

(setq att (getvar 'attdia))
(setvar 'attdia 0)
(if (tblsearch "BLOCK" blkname)
(PRINC "FOUND") ; block exists
(Make_bubble)
)
 (setq ah:ans (AH:getvalsm (list "Enter Pt details" "eg 1 a A " 5 4 "11" "Scale " 5 4 "100")))
    (setq ptnum (nth 0 ah:ans))
    (setq sc (atof (nth 1 ah:ans)))

  (if (or (/= 1 (getvar 'cvport))(= "Model" (getvar 'ctab)))
        (setq sc (/ sc 1000.0 ))
        (setq sc 1.0)
  )

  (setq oldsnap (getvar "osmode"))
  (setvar "textstyle" "standard")

  (setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
  (if (< chrnum 58)
  (setq ptnumb (atof ptnum)) ;convert back to a number
  )

  (while (setq pt (getpoint "\Pick end of line or Enter to exit"))
    (setq pt2 (polar pt (/ pi 2.0) 3.25))
    (setvar "osmode" 0)

    (if (< chrnum 58)
      (progn
(command "-insert"
blkname
pt
sc
""
0
(rtos ptnumb 2 0)
)
(setq ptnumb (+ ptnumb 1))
      )
      (progn
(command "-insert"
blkname
pt
sc
""
0
(chr chrnum)
)
(setq chrnum (+ chrnum 1))
      )
    )
  ;  (command "move" "L" "" pt pt2)
 ;   (setvar "osmode" 1)
  )

  (setvar "osmode" oldsnap)
  (princ)
)

;;;;;;
; program starts here

(alert "Type Bub to repeat\n\nYou can do alpha's or numbers\n \nSquare or circles")

(C:BUB)