28.01.2023 21:13    

bayankapris61
Merhabalar,
Sayfa numarası veren bu lispte her bir arttırım için tek tek sayfaları seçmem gerekiyor. Toplu bir şekilde seçtiğim yol üzerindeki sayfaları tek seferde numaralandırmak için ne eklemem gerekiyor . yardımcı olabilir misiniz.
Kod:

(defun c:PageNo ()
  (setvar "cmdecho" 0)(command "undo" "group")
  (if (= nil esayi) (setq esayi 1))
  (setq sayi (getint
               (strcat
                 "\nBaslangic sayisi (bLock seçmek için negatif sayı giriniz) <"
                             (itoa esayi) "> :")))
  (if (= sayi nil)
    (setq sayi esayi)
    (if (< sayi 0)
      (progn
        (setq refr (car (entsel "\nSon numarayı almak istediğiniz bLock seçiniz...")))
        (if (and (= (cdr (assoc 0 (entget refr))) "INSERT")
                 (= (cdr (assoc 66 (entget refr))) 1))
          (while (= (cdr (assoc 0 (entget (setq refr (entnext refr))))) "ATTRIB")
            (if (= (cdr (assoc 2 (entget refr))) "PageNo")
              (setq sayi (atoi (cdr (assoc 1 (entget refr)))))))))))
  (if (= amk nil) (setq eamk 1))
  (setq amk (getint (strcat "Artis miktari <" (itoa eamk) "> : ")))
  (if (= nil amk) (setq amk eamk))
  (while (setq bLck (car (entsel "\Numaralandırılmak istenen bLock'u seçiniz")))
    (while (= (cdr (assoc 0 (entget (setq bLck (entnext bLck))))) "ATTRIB")
      (if (= (cdr (assoc 2 (entget bLck))) "PageNo")
        (progn
          (setq sayi (1+ sayi))
          (if (< sayi 10)
            (setq sy (strcat "0" (itoa sayi))) (setq sy (itoa sayi)))
          (setq pivot (entget bLck)
                pivot (subst (cons 1 sy) (assoc 1 pivot) pivot)
                esayi sayi)
          (entmod pivot) (entupd (cdr (assoc -1 pivot)))))))
  (command "undo" "e")(prin1)
)

ProhibiT (13.02.2023 10:16 GMT)

12.02.2023 20:37    

bayankapris61
Merhabalar,
Geçenlerde biri dönüş yapmış ama yoğunluktan ve sonra yaşadığımız bu olaylardan sonra da fırsat olmadı, lütfen kusura bakmayın. şu an ona ulaşamıyorum, sanırım yazdığını kaldırmış. Gerçekten geri dönemediğim için çok üzgünüm, yardımcı olmaya çalıştığınızı biliyorum. İsteğimi anlatan bir taslak dwg yi ekliyorum toplu bir seçimde seçtiğim sıradan sayfa numarasını arttırarak tek seferde numaralandırmak istiyorum. Yardımcı olursanız çok sevinirim, şimdiden teşekkür ederim. 381614-denemedwg.dwg

13.02.2023 05:41    

baha07
iki cevap var , sirasiyla okuyun lutfen

1- merhabalar
lee mac bey`in lispini senin PageNo tag in ile revize ettim . siz ciziminizde blok ismini deneme yapmissiniz onu myblock olarak degistirirseniz bu lisp direk calisacak yada lispin girisindeki blok adini ciziminizdeki blok adini yazmaniz gerekiyor .
lispi calistirdiginda ekranda ne kadar attributes in varsa olusturulma sirasina gore 01 den baslayarak numara veriyor . yeni kopyalarsan lispi tekrar calistirman gerekiyor . yeni dwg de bir onceki dwg de bulunan sayfa numarasinin uzerinden devam etsin istersen lispin girisinde bulunan ayarlar bolumunden autolabel:start yazan yazinin karsindakini 1 i istedigin baslangis sayisiyla degistirip lisp tekrar kaydetmen ve tekrar yuklemen gerekiyor (sayfa kopyalarken otamatik sayfa numarasi verme islevini bulamadim) . lisp suanda 01 ile basliyor autolabel:length karsindaki degistirerek 1-2-3 , 1 -01 -001 olarak olustururyor

276810-381614-denemedwg.dwg
Kod:

;;---------------------=={ AutoLabel Attributes }==---------------------;;
;;                                                                      ;;
;;  This program will automatically populate a specific attribute tag   ;;
;;  with a unique label within a set of attributed blocks, renumbering  ;;
;;  if blocks are added, copied or erased.                              ;;
;;                                                                      ;;
;;  The program uses an Object Reactor to monitor modification events   ;;
;;  for the set of all attributed blocks with a block name matching     ;;
;;  a block name or wildcard pattern specified within the program       ;;
;;  source code.                                                        ;;
;;                                                                      ;;
;;  Following modification to any matching attributed block, a Command  ;;
;;  Reactor will trigger the program to automatically renumber a        ;;
;;  specific attribute tag held by all matching attributed blocks in    ;;
;;  the active layout of the drawing.                                   ;;
;;                                                                      ;;
;;  The block references are numbered in the order in which they are    ;;
;;  encountered in the drawing database of the active drawing           ;;
;;  (that is, the order in which the blocks were created).              ;;
;;                                                                      ;;
;;  The program also allows the user to specify a numbering prefix &    ;;
;;  suffix, the starting number for the numbering, and the number of    ;;
;;  characters to be used for fixed length numbering with leading zeros ;;
;;  (i.e. if the numbering length is set to 2, the program will number  ;;
;;  the blocks 01,02,03,...,10,11,12).                                  ;;
;;                                                                      ;;
;;  The autonumbering functionality is automatically enabled on drawing ;;
;;  startup when the program is loaded, and may be subsequently enabled ;;
;;  or disabled manually using the commands 'AUTOLABELON' &             ;;
;;  'AUTOLABELOFF' respectively.                                        ;;
;;----------------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com                 ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2011-09-14                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2015-09-20                                      ;;
;;                                                                      ;;
;;  - Program entirely rewritten.                                       ;;
;;  - Added callback function to handle command cancelled & command     ;;
;;    failed events when modifying autonumbered blocks.                 ;;
;;  - Added the ability to specify a numbering prefix & suffix,         ;;
;;    specify a starting number, and use fixed length numbering         ;;
;;    (i.e numbering with leading zeros: 01,02,...,10).                 ;;
;;  - Block Name & Attribute Tag parameters may now use wildcards to    ;;
;;    match multiple block names & tags (the first attribute tag which  ;;
;;    matches the wildcard pattern will be numbered).                   ;;
;;  - Incorporated compatibility for Multiline Attributes.              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2015-09-27                                      ;;
;;                                                                      ;;
;;  - Program modified to only increment numbering counter if an        ;;
;;    attribute matching the target tag name is found.                  ;;
;;  - Implemented compatibility for multileader blocks.                 ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2018-10-27                                      ;;
;;                                                                      ;;
;;  - Fixed bug in autolabel:getattributetagid function preventing      ;;
;;    numbering of multileader attributed blocks.                       ;;
;;----------------------------------------------------------------------;;
;;  Version 1.4    -    2020-02-15                                      ;;
;;                                                                      ;;
;;  - Program modified to account for attributed MInsert Blocks.        ;;
;;----------------------------------------------------------------------;;
(setq
;;----------------------------------------------------------------------;;
;;                               Settings                               ;;
;;----------------------------------------------------------------------;;
    autolabel:blockname "myblock"  ;; Name of block to be updated (not case-sensitive / may use wildcards)
    autolabel:blocktag  "PageNo"    ;; Attribute tag to be updated (not case-sensitive / may use wildcards)
    autolabel:prefix    ""         ;; Numbering prefix (use "" for none)
    autolabel:suffix    ""         ;; Numbering suffix (use "" for none)
    autolabel:start     1          ;; Starting number
    autolabel:length    2          ;; Fixed length numbering (set to zero if not required)
    autolabel:startup   t          ;; Enable on drawing startup (t=enable / nil=disable)
    autolabel:objtype   3          ;; Bit-coded integer > 0 (1=attributed blocks; 2=multileader blocks)
;;----------------------------------------------------------------------;;
)
;;----------------------------------------------------------------------;;
;;                             Main Program                             ;;
;;----------------------------------------------------------------------;;
(defun autolabel:objectreactorcallback:renumberblocks ( own rtr arg )
    (if (null autolabel:commandreactor)
        (setq autolabel:commandreactor
            (vlr-command-reactor "autolabel"
               '(
                    (:vlr-commandended     . autolabel:commandreactorcallback:renumberblocks)
                    (:vlr-commandcancelled . autolabel:commandreactorcallback:cancelled)
                    (:vlr-commandfailed    . autolabel:commandreactorcallback:cancelled)
                )
            )
        )
    )
    (princ)
)
(defun autolabel:commandreactorcallback:cancelled ( rtr arg )
    (if (= 'vlr-command-reactor (type autolabel:commandreactor))
        (progn
            (vlr-remove autolabel:commandreactor)
            (setq autolabel:commandreactor nil)
        )
    )
    (princ)
)
(defun autolabel:commandreactorcallback:renumberblocks ( rtr arg / att blk idx num obj oid sel )
    (if (= 'vlr-command-reactor (type autolabel:commandreactor))
        (progn
            (vlr-remove autolabel:commandreactor)
            (setq autolabel:commandreactor nil)
        )
    )
    (if (= 'vlr-object-reactor (type autolabel:objectreactor))
        (vlr-remove autolabel:objectreactor)
    )
    (if
        (and (not autolabel:undoflag)
            (setq sel
                (ssget "_X"
                    (append
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "<OR"))
                        )
                        (if (= 1 (logand 1 autolabel:objtype))
                            (list '(-4 . "<AND") '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," autolabel:blockname)) '(-4 . "AND>"))
                        )
                        (if (= 2 (logand 2 autolabel:objtype))
                           '((0 . "MULTILEADER"))
                        )
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "OR>"))
                        )
                        (if (= 1 (getvar 'cvport))
                            (list (cons 410 (getvar 'ctab)))
                           '((410 . "Model"))
                        )
                    )
                )
            )
        )
        (progn
            (setq num autolabel:start)
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
                    (if (setq att (autolabel:getattribute obj))
                        (progn
                            (vla-put-textstring att
                                (strcat
                                    autolabel:prefix
                                    (autolabel:padzeros (itoa num) autolabel:length)
                                    autolabel:suffix
                                )
                            )
                            (setq num (1+ num))
                            (autolabel:addowner obj)
                        )
                    )
                    (if (and (= acblockcontent (vla-get-contenttype obj))
                             (wcmatch (setq blk (strcase (vla-get-contentblockname obj))) autolabel:blockname)
                             (setq oid (autolabel:getattributetagid blk))
                        )
                        (progn
                            (autolabel:setblockattributevalue obj oid
                                (strcat
                                    autolabel:prefix
                                    (autolabel:padzeros (itoa num) autolabel:length)
                                    autolabel:suffix
                                )
                            )
                            (setq num (1+ num))
                            (autolabel:addowner obj)
                        )
                    )
                )
            )
        )
    )
    (if (= 'vlr-object-reactor (type autolabel:objectreactor))
        (vlr-add autolabel:objectreactor)
    )
    (princ)
)
(defun autolabel:commandreactorcallback:undocheck ( rtr arg )
    (setq autolabel:undoflag (= (strcase (car arg) t) "undo"))
    (princ)
)
(defun autolabel:commandreactorcallback:blockinserted ( rtr arg / att blk ent enx idx new num obj oid sel )
    (if
        (and
            (not autolabel:undoflag)
            (wcmatch (strcase (car arg) t)
                (strcat
                    (if (= 1 (logand 1 autolabel:objtype)) "-insert,insert,executetool" "")
                    (if (= 3 (logand 3 autolabel:objtype)) "," "")
                    (if (= 2 (logand 2 autolabel:objtype)) "mleader" "")
                )
            )
            (setq ent (entlast))
            (setq new (vlax-ename->vla-object ent))
            (setq enx (entget ent))
            (or
                (and
                    (= 1 (logand 1 autolabel:objtype))
                    (= "INSERT" (cdr (assoc 0 enx)))
                    (= 1 (cdr (assoc 66 enx)))
                    (wcmatch (autolabel:effectivename new) autolabel:blockname)
                )
                (and
                    (= 2 (logand 2 autolabel:objtype))
                    (= "MULTILEADER" (cdr (assoc 0 enx)))
                    (= acblockcontent (vla-get-contenttype new))
                    (wcmatch (strcase (vla-get-contentblockname new)) autolabel:blockname)
                )
            )
            (setq sel
                (ssget "_X"
                    (append
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "<OR"))
                        )
                        (if (= 1 (logand 1 autolabel:objtype))
                            (list '(-4 . "<AND") '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," autolabel:blockname)) '(-4 . "AND>"))
                        )
                        (if (= 2 (logand 2 autolabel:objtype))
                           '((0 . "MULTILEADER"))
                        )
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "OR>"))
                        )
                        (if (= 1 (getvar 'cvport))
                            (list (cons 410 (getvar 'ctab)))
                           '((410 . "Model"))
                        )
                    )
                )
            )
        )
        (progn
            (setq num (1- autolabel:start))
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
                    (if (autolabel:getattribute obj)
                        (setq num (1+ num))
                    )
                    (if (and (= acblockcontent (vla-get-contenttype obj))
                             (wcmatch (setq blk (strcase (vla-get-contentblockname obj))) autolabel:blockname)
                             (autolabel:getattributetagid blk)
                        )
                        (setq num (1+ num))
                    )
                )
            )
            (if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
                (if (setq att (autolabel:getattribute new))
                    (progn
                        (vla-put-textstring att
                            (strcat
                                autolabel:prefix
                                (autolabel:padzeros (itoa num) autolabel:length)
                                autolabel:suffix
                            )
                        )
                        (autolabel:addowner new)
                    )
                )
                (if (setq oid (autolabel:getattributetagid (vla-get-contentblockname new)))
                    (progn
                        (autolabel:setblockattributevalue new oid
                            (strcat
                                autolabel:prefix
                                (autolabel:padzeros (itoa num) autolabel:length)
                                autolabel:suffix
                            )
                        )
                        (autolabel:addowner new)
                    )
                )
            )
        )
    )
    (princ)
)
(defun autolabel:addowner ( obj )
    (if
        (and
            (= 'vlr-object-reactor (type autolabel:objectreactor))
            (not (member obj (vlr-owners autolabel:objectreactor)))
        )
        (vlr-owner-add autolabel:objectreactor obj)
    )
)
(defun autolabel:getattribute ( blk )
    (if (wcmatch (strcase (autolabel:effectivename obj)) autolabel:blockname)
        (vl-some
           '(lambda ( att )
                (if (wcmatch (strcase (vla-get-tagstring att)) autolabel:blocktag) att)
            )
            (vlax-invoke blk 'getattributes)
        )
    )
)
(defun autolabel:getattributetagid ( blk )
    (eval
        (list 'defun 'autolabel:getattributetagid '( blk / itm tmp )
            (list 'if
               '(setq itm (assoc (strcase blk) autolabel:attributetagids))
               '(cdar (vl-member-if '(lambda ( att ) (wcmatch (car att) autolabel:blocktag)) (cdr itm)))
                (list 'progn
                    (list 'vlax-for 'obj (list 'vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 'blk)
                       '(if
                            (and
                                (= "AcDbAttributeDefinition" (vla-get-objectname obj))
                                (= :vlax-false (vla-get-constant obj))
                            )
                            (setq tmp
                                (cons
                                    (cons
                                        (strcase (vla-get-tagstring obj))
                                        (autolabel:objectid obj)
                                    )
                                    tmp
                                )
                        )
                        )
                    )
                   '(setq autolabel:attributetagids (cons (cons (strcase blk) tmp) autolabel:attributetagids))
                   '(autolabel:getattributetagid blk)
                )
            )
        )
    )
    (autolabel:getattributetagid blk)
)
(defun autolabel:setblockattributevalue ( obj idx str )
    (if (vlax-method-applicable-p obj 'setblockattributevalue32)
        (defun autolabel:setblockattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
        (defun autolabel:setblockattributevalue ( obj idx str ) (vla-setblockattributevalue   obj idx str))
    )
    (autolabel:setblockattributevalue obj idx str)
)
(defun autolabel:objectid ( obj )
    (if (vlax-property-available-p obj 'objectid32)
        (defun autolabel:objectid ( obj ) (vla-get-objectid32 obj))
        (defun autolabel:objectid ( obj ) (vla-get-objectid   obj))
    )
    (autolabel:objectid obj)
)
(defun autolabel:effectivename ( obj )
    (if (vlax-property-available-p obj 'effectivename)
        (defun autolabel:effectivename ( obj ) (strcase (vla-get-effectivename obj)))
        (defun autolabel:effectivename ( obj ) (strcase (vla-get-name obj)))
    )
    (autolabel:effectivename obj)
)
(defun autolabel:padzeros ( str len )
    (if (< (strlen str) len)
        (autolabel:padzeros (strcat "0" str) len)
        str
    )
)
(defun autolabel:disable ( key )
    (foreach grp (vlr-reactors :vlr-command-reactor :vlr-object-reactor)
        (foreach obj (cdr grp)
            (if (= key (vlr-data obj)) (vlr-remove obj))
        )
    )
    (setq autolabel:undoflag       nil
          autolabel:objectreactor  nil
          autolabel:commandreactor nil
    )
)
(defun autolabel:enable ( key )
    (autolabel:disable key)
    (vlr-set-notification
        (setq autolabel:objectreactor
            (vlr-object-reactor nil key
               '(
                    (:vlr-erased   . autolabel:objectreactorcallback:renumberblocks)
                    (:vlr-copied   . autolabel:objectreactorcallback:renumberblocks)
                    (:vlr-unerased . autolabel:objectreactorcallback:renumberblocks)
                )
            )
        )
        'active-document-only
    )
    (vlr-set-notification
        (vlr-command-reactor key
           '(
                (:vlr-commandwillstart . autolabel:commandreactorcallback:undocheck)
                (:vlr-commandended     . autolabel:commandreactorcallback:blockinserted)
            )
        )
        'active-document-only
    )
    (autolabel:commandreactorcallback:renumberblocks nil nil)
    (princ
        (strcat
            "\nAutonumbering enabled for tags matching ""
            autolabel:blocktag
            "" within "
            (if (= 1 (logand 1 autolabel:objtype)) "blocks" "")
            (if (= 3 (logand 3 autolabel:objtype)) " & " "")
            (if (= 2 (logand 2 autolabel:objtype)) "multileaders" "")
            " matching ""
            autolabel:blockname
            ""."
        )
    )
    (princ)
)
;;----------------------------------------------------------------------;;
;;                         Loading Expressions                          ;;
;;----------------------------------------------------------------------;;
(   (lambda nil
        (vl-load-com)
        (cond
            (   (vl-some
                    (function
                        (lambda ( val par )
                            (if (/= 'str (type val))
                                (princ (strcat "\nThe " par " parameter must be a valid string."))
                            )
                        )
                    )
                    (list
                        autolabel:blockname
                        autolabel:blocktag
                        autolabel:prefix
                        autolabel:suffix
                    )
                   '(
                        "Block Name"
                        "Attribute Tag"
                        "Numbering Prefix"
                        "Numbering Suffix"
                    )
                )
            )
            (   (/= 'int (type autolabel:start))
                (princ "\nThe Starting Number parameter must hold an integer value.")
            )
            (   (/= 'int (type autolabel:length))
                (princ "\nThe Fixed Length Numbering parameter must hold an integer value.")
            )
            (   (not
                    (and
                        (= 'int (type autolabel:objtype))
                        (< 0 autolabel:objtype)
                        (< 0 (logand 3 autolabel:objtype))
                    )
                )
                (princ "\nThe Object Type parameter must hold a bit-coded integer value between 1 & 3.")
            )
            (   (setq autolabel:blockname (strcase autolabel:blockname)
                      autolabel:blocktag  (strcase autolabel:blocktag)
                )
                (defun c:autolabelon nil
                    (autolabel:enable "autolabel")
                )
                (defun c:autolabeloff nil
                    (autolabel:disable "autolabel")
                    (princ "\nAutonumbering disabled.")
                    (princ)
                )
                (if autolabel:startup (autolabel:enable "autolabel"))
            )
        )
        (princ)
    )
)
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

baha07 (13.02.2023 07:17 GMT)

13.02.2023 07:13    

baha07
2- tekrar merhaba
sizin istediginiz bu sanirim
lispin girisinde sordugu tag ismini girmeyi unutmayin .
Kod:

;;; Fill in multiple attributes in sequence
;;; 2022.5.9 forums.autodesk.com    by 3wood
(defun C:FMA (/ def1 def2 def3 n1 ss1)
  (setq FMA_PATTERN (getstring (strcat "\nEnter tag pattern <" (setq def1 (if (not FMA_PATTERN) "*" FMA_PATTERN)) ">: "))) ;Attribute search pattern, using wildcard
  (if (equal FMA_PATTERN "") (setq FMA_PATTERN def1))
  (setq FMA_PREFIX (getstring T (strcat "\nEnter prefix <" (setq def2 (if (not FMA_PREFIX) "" FMA_PREFIX)) ">: "))) ;Prefix in attribute value
  (cond ((equal FMA_PREFIX "") (setq FMA_PREFIX def2))
((equal FMA_PREFIX " ") (setq FMA_PREFIX "")) ;Enter a space to remove prefix
)
  (setq FMA_START (getint (strcat "\nEnter start number <" (setq def3 (if (not FMA_START) "1" (itoa FMA_START))) ">: "))) ;Number sequence start number
  (if (not FMA_START) (setq FMA_START (atoi def3)))
  (setq n1 0)
  (if (and
(setq ss1 (ssget '((-4 . "<AND")(0 . "INSERT")(66 . 1)(-4 . "AND>"))))
)
    (repeat (sslength ss1)
      (foreach r1 (vlax-safearray->list (vlax-variant-value  (vla-getattributes (vlax-ename->vla-object (ssname ss1 n1)))))
(if (wcmatch (vla-Get-Tagstring r1) FMA_PATTERN)
  (progn
    (vla-Put-Textstring r1 (strcat FMA_PREFIX (itoa FMA_START)))
    (setq FMA_START (1+ FMA_START))
    )
  )
)
      (setq n1 (1+ n1))
      )
    )
  (princ)
  )

baha07 (13.02.2023 08:26 GMT)

13.02.2023 09:23    

alumina
Alıntı
baha07 :


soldan saga dogru sirayla arttiriyor degil mi?

13.02.2023 10:14    

baha07
Alıntı
alumina :
Alıntı
baha07 :

soldan saga dogru sirayla arttiriyor degil mi?


-birinci cevaptaki nesnenin olusturulma sirasina gore
-ikinci cevaptakinde iki durumvar multi tektek secimde secim sirasina gore veriyor
4>>>>>2>>>>1>>>>3 >>>>5>>>>6
- multi toplu secersen sagdan sola ve alttan yukari dogru verdi
SONNO<<<<<<<<<<<
<<<<<<<<<<<<
<<<<<<<<<<<ILKno

13.02.2023 10:19    

alumina
Alıntı
baha07 :

Ornek dosyada yan yana duruyor antetler. Soldan saga dogru arttirarak gitse cok guzel olurdu. Rica etsem kodu buna gore duzenlermisiniz..

13.02.2023 15:14    

baha07
Alıntı
alumina :
Alıntı
baha07 :

Ornek dosyada yan yana duruyor antetler. Soldan saga dogru arttirarak gitse cok guzel olurdu. Rica etsem kodu buna gore duzenlermisiniz..




ugrastimda olmadi . birazdaha bakinayim

13.02.2023 16:07    

alumina
Alıntı
baha07 :

Yaparsiniz siz

13.02.2023 18:18    

alumina
Alıntı
bayankapris61 :

Kod:

(defun c:qw (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getint "\nEnter the starting number <1>:")))
        (setq k 1))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr
                         (ssnamex ss))))) '(lambda(a b)
                           (< (caar a) (caar b)))))
        (foreach n (vlax-invoke m 'GetAttributes)
          (if (eq (vla-get-TagString n) "PageNo")
            (vla-put-TextString n (itoa k))))
        (setq k (1+ k)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)

14.02.2023 05:43    

bayankapris61
Elinize emeğinize sağlık

14.02.2023 07:17    

baha07
Alıntı
alumina :


merhaba
sizin dediginiz gibi tek sira oldugunda x leri siraliyor ama (soldan saga - koor olarak kucukten buyuge )
sutunlu sekle gecildiginde siralamada Y lere oncelik veriyor

alumina (14.02.2023 07:28 GMT)

14.02.2023 07:29    

alumina
Alıntı
baha07 :

Y'lere gecince yukardan asagiya siralamasini istersen, artik onuda sen ekle.

14.02.2023 09:46    

baha07
Alıntı
alumina :
Alıntı
baha07 :

Y'lere gecince yukardan asagiya siralamasini istersen, artik onuda sen ekle.


bu duzeltme oldu da .

baska problem var , satir ve sutun seklindeki duzenlerde tek tek secmelerde (aralardan secersen ) secim sirasina gore takip etmiyor .
Kod:

;;---------------------=={ AutoLabel Attributes }==----------------------;;
;;  Attributes   sayfa numarasi vermek icin                              ;;
;;  attribute tag ismi PageNo olanlara baslangic numarasi isteyerek      ;;
;;  numarandirir , coklu secmelerde  soldan saga baslayarak veririr      ;;
;;  sizin taginizin ismi farkli ise assagidaki PageNo yazisina taginizin ;;
;;  ismini verebilirsiniz                                                ;;
;;   cizim okulu       13.02.2023                                 ;;
;;-----------------------------------------------------------------------;;
(defun c:pg (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getint "\nEnter the starting number <1>:")))
        (setq k 1))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr
                         (ssnamex ss))))) '(lambda(a b)
                           (and (or (<= (caar a) (caar b))
       (>= (cadar a) (cadar b))
          )
          (>= (cadar a) (cadar b))
     )
)))
        (foreach n (vlax-invoke m 'GetAttributes)
          (if (eq (vla-get-TagString n) "PageNo")
            (vla-put-TextString n (itoa k))))
        (setq k (1+ k)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)

baha07 (14.02.2023 14:42 GMT)

14.02.2023 10:29    

alumina
Alıntı
baha07 :

Vl-sort ayni anda birden fazla kosulla calismaz !!!!
Birde kod uzerinde duzenleme yapip altina benim adimi yazma :)

Kod:

(defun c:qw (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getint "\nEnter the starting number <1>:")))
        (setq k 1))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object (vl-remove-if
                       'listp (mapcar 'cadr (ssnamex ss)))))
                         '(lambda(a b) (> (cadar a) (cadar b))))
                            '(lambda(a b) (< (caar a) (caar b)))))
        (foreach n (vlax-invoke m 'GetAttributes)
          (if (eq (vla-get-TagString n) "PageNo")
            (vla-put-TextString n (itoa k))))
        (setq k (1+ k)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)

14.02.2023 10:45    

baha07
daha once sizin gonderdiginiz koda yazmistim . daha sonra kalmis dikkat etmedim . dikkat ederim

baha07 (14.02.2023 10:53 GMT)

01.05.2023 10:54    

bayankapris61
Selamlar,
noktalı sayılar için çalıştırabilir miyiz. Mesela 12.100 , 12.101 ....

Alıntı
alumina :
Alıntı
baha07 :

Vl-sort ayni anda birden fazla kosulla calismaz !!!!
Birde kod uzerinde duzenleme yapip altina benim adimi yazma :)
Kod:

(defun c:qw (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getint "\nEnter the starting number <1>:")))
        (setq k 1))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object (vl-remove-if
                       'listp (mapcar 'cadr (ssnamex ss)))))
                         '(lambda(a b) (> (cadar a) (cadar b))))
                            '(lambda(a b) (< (caar a) (caar b)))))
        (foreach n (vlax-invoke m 'GetAttributes)
          (if (eq (vla-get-TagString n) "PageNo")
            (vla-put-TextString n (itoa k))))
        (setq k (1+ k)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)


01.05.2023 13:10    

alumina
Alıntı
bayankapris61 :

Kod:

(defun c:qw (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getreal "\nEnter the starting number <1.001>:")))
        (setq k 1.001))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object (vl-remove-if
                       'listp (mapcar 'cadr (ssnamex ss)))))
                         '(lambda(a b) (> (cadar a) (cadar b))))
                            '(lambda(a b) (< (caar a) (caar b)))))
        (vl-some '(lambda(a) (if (eq (vla-get-TagString a) "PageNo")
          (vla-put-TextString a (rtos k 2 3))))
            (vlax-invoke m 'GetAttributes))
        (setq k (+ k 0.001)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)

04.05.2023 06:26    

bayankapris61
Çok teşekkür ederim.
bu kısımda bazı yerlerdeki attribute taglerimde farklılaşmalar var. Bu şekilde çoklu filtreye sokamadım.
(vl-some '(lambda(a) (if (eq (vla-get-TagString a) "*PageNo*,*Pageno*,*PAGENO*")



Alıntı
alumina :
Alıntı
bayankapris61 :

Kod:

(defun c:qw (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getreal "\nEnter the starting number <1.001>:")))
        (setq k 1.001))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object (vl-remove-if
                       'listp (mapcar 'cadr (ssnamex ss)))))
                         '(lambda(a b) (> (cadar a) (cadar b))))
                            '(lambda(a b) (< (caar a) (caar b)))))
        (vl-some '(lambda(a) (if (eq (vla-get-TagString a) "PageNo")
          (vla-put-TextString a (rtos k 2 3))))
            (vlax-invoke m 'GetAttributes))
        (setq k (+ k 0.001)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)


04.05.2023 11:50    

alumina
Alıntı
bayankapris61 :

Kodun bilmem kacinci versiyonu oldu, gonderirsin artik bir Trabzon tereyagi :)
Kod:

(defun c:qw (/ dc ss k)
            (vl-load-com)
  (if (setq dc (vla-get-ActiveDocument
          (vlax-get-acad-object))
        ss (ssget '((0 . "Insert") (66 . 1))))
    (progn (initget 4)
      (if (not (setq k (getreal "\nEnter the starting number <1.001>:")))
        (setq k 1.001))
      (vla-StartUndomark dc)
      (foreach m (mapcar 'cadr (vl-sort (vl-sort (mapcar '(lambda(x)
                   (list (vlax-get x 'InsertionPoint) x))
                     (mapcar 'vlax-ename->vla-object (vl-remove-if
                       'listp (mapcar 'cadr (ssnamex ss)))))
                         '(lambda(a b) (> (cadar a) (cadar b))))
                            '(lambda(a b) (< (caar a) (caar b)))))
        (vl-some '(lambda(a) (if (wcmatch (vla-get-TagString a)
            "*[Pp][Aa][Gg][Ee][Nn][Oo]*")
          (vla-put-TextString a (rtos k 2 3))))
            (vlax-invoke m 'GetAttributes))
        (setq k (+ k 0.001)))
      (vla-EndUndomark dc)
    )
  ) (prin1)
)

> 1 <
Copyright © 2004-2022 SQL: 1.894 saniye - Sorgu: 112 - Ortalama: 0.01691 saniye