Results 1 to 3 of 3

Thread: Number Polygons - help to update the code

  1. #1
    topomav
    Guest
    Login to Give a bone
    0

    Default Number Polygons - help to update the code

    Hi I am using this code to number polygons. This code have only the option to number polygons as 1,2,3,4,...... Some times need to number the code as A1,A2,A..... B1,B2... any letter or 1A,2A,3A,.......

    So I was thinking that is a good update to add an option for [prefix/suffix]. If I don't select any of them insert just numbers

    Code:
    (defun c:TEST (/ scl ht d sel e sum verts ptList p_)
        ;(setq scl (getvar "useri1"))  <---DONT DELETE IT
       ; (setq ht (* 0.0025 scl))  <---DONT DELETE IT
       ; (setq d (* 0.0035 scl))  <---DONT DELETE IT
        (command "_layer" "_m" "NO" "_c" "161" "" "")
          (setq inc  (cond
                           ((getint (strcat "\nEnter number"
                                            (if inc
                                                  (strcat " <"
                                                          (itoa inc)
                                                          ">: ")
                                                  ": ")
                                            )))
                           (inc))
                )
    
          (if
                (setq ss (ssget '((0 . "LWPOLYLINE"))))
    
                     (repeat (sslength ss)
                           (setq e (ssname ss 0)
                                 sum '(0 0)
                                 verts (cdr (assoc 90 (setq ent (entget e)))))
                           (setq ptList
                                      (mapcar 'cdr
                                              (vl-remove-if-not
                                                    '(lambda (x) (= (car x) 10))
                                                    ent)))
                           (foreach x ptList (setq sum (mapcar '+ x sum)))
                           (setq p_ (mapcar '/ sum (list verts verts)))
                           (entmakex
                                 (list
                                       (cons 0 "TEXT")
                                       (cons 10 p_)
                                       (cons 11 p_)
                                       ;(cons 40 ht)
                                       (cons 40 0.50)
                                       (cons 7 "TopoCAD")
                                       '(72 . 4)
                                       '(73 . 3)
                                       (cons 1 (itoa inc))
                                  )
                           )
                           (entmakex
                                 (list (cons 0 "CIRCLE")
                                       (cons 10 p_)
                                       ;(cons 40 d)    <---DONT DELETE IT
                                       (cons 40 1.40)
                                 )
                           )
                           (setq inc (1+ inc))
                           (ssdel e ss)
                  )
          )
          (princ)
    ;layer 0
    (mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))
    (princ)
          )

  2. #2
    topomav
    Guest
    Login to Give a bone
    0

    Default Re: Number Polygons - help to update the code

    Can anyone help?

    Thanks

  3. #3
    topomav
    Guest
    Login to Give a bone
    0

    Default Re: Number Polygons - help to update the code

    I try this. Is any better way to do this?

    Code:
    (defun c:TEST (/ scl ht d sel e sum verts ptList p_)
    (setq scl(/ (getreal  "\n select scale  (100,200,500,etc) : ") 100))
        ;(setq scl (getvar "useri1"))  <---DONT DELETE IT
       ; (setq ht (* 0.0025 scl))  <---DONT DELETE IT
       ; (setq d (* 0.0035 scl))  <---DONT DELETE IT
        (command "_layer" "_m" "NO" "_c" "161" "" "")
          (setq inc  (cond
                           ((getint (strcat "\nEnter number"
                                            (if inc
                                                  (strcat " <"
                                                          (itoa inc)
                                                          ">: ")
                                                  ": ")
                                            )))
                           (inc))
                )
          (setq x (getstring "\nSpecify prefix <enter for none>: "))
    
          (if
                (setq ss (ssget '((0 . "LWPOLYLINE"))))
    
                     (repeat (sslength ss)
                           (setq e (ssname ss 0)
                                 sum '(0 0)
                                 verts (cdr (assoc 90 (setq ent (entget e)))))
                           (setq ptList
                                      (mapcar 'cdr
                                              (vl-remove-if-not
                                                    '(lambda (x) (= (car x) 10))
                                                    ent)))
                           (foreach x ptList (setq sum (mapcar '+ x sum)))
                           (setq p_ (mapcar '/ sum (list verts verts)))
                           (entmakex
                                 (list
                                       (cons 0 "TEXT")
                                       (cons 10 p_)
                                       (cons 11 p_)
                                       ;(cons 40 ht)
                                       (cons 40 0.50)
                                       (cons 7 "TopoCAD")
                                       '(72 . 4)
                                       '(73 . 3)
                                       (cons 1  (strcat x (itoa inc)))
                                  )
                           )
                           (entmakex
                                 (list (cons 0 "CIRCLE")
                                       (cons 10 p_)
                                       ;(cons 40 d)    <---DONT DELETE IT
                                       (cons 40 1.40)
                                 )
                           )
                           (setq inc (1+ inc))
                           (ssdel e ss)
                  )
          )
          (princ)
    ;layer 0
    (mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))
    (princ)
          )
    And if I want to add a sufix how to do it without add ???



    Code:
          (setq x (getstring "\nSpecify prefix <enter for none>: "))
          (setq y (getstring "\nSpecify prefix <enter for none>: "))
            (cons 1  (strcat x (itoa inc) y))
    Thanks
    Last edited by Razor; 2023-01-11 at 02:25 PM.

Similar Threads

  1. Need a help in modification of lisp. Please update the lisp code as required.
    By brahmanandam.thadikonda762224 in forum AutoLISP
    Replies: 0
    Last Post: 2018-09-20, 04:12 AM
  2. Allow Other Code Compilers for ARX Code
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 2
    Last Post: 2013-02-10, 08:06 AM
  3. Replies: 0
    Last Post: 2011-11-17, 02:45 AM
  4. Insert vbscript code has not code
    By buzz in forum AMEP General
    Replies: 3
    Last Post: 2008-02-09, 03:08 AM
  5. Convert VBA code to VB code
    By Robert Platt in forum VBA/COM Interop
    Replies: 20
    Last Post: 2007-08-15, 10:13 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •