18.12.2015 19:48    

defikol
Merhaba arkadaşlar

Kapalı polyline içinde kalan blokları saydıran lisp arıyorum bulamadım. Lisp yazmayı da bilmiyorum yardım edebilcek varmı?

19.12.2015 22:37    

alumina
Alıntı
defikol :



Kod:

(defun c:bn (/ p b i sr bn l m)
  (if (setq p (ssget ":s" '((0 . "*polyline") (70 . 1))))
    (if (setq b (ssget "wp" (mapcar 'cdr (vl-remove-if-not '(lambda(a) (= (car a) 10))
          (entget (ssname p 0)))) (list (cons 0 "insert"))))
      (progn
        (repeat (setq i (sslength b))
          (if (setq sr (vl-position (setq bn (cdr (assoc 2 (entget (ssname b
                (setq i (1- i))))))) (mapcar '(lambda(b) (car b)) l)))
            (setq l (subst (list (car (nth sr l)) (1+ (cadr (nth sr l)))) (nth sr l) l))
            (setq l (cons (list bn 1) l))))
        (foreach m (vl-sort l '(lambda (x y) (< (car x) (car y))))
          (princ (strcat "\n" (car m) ": " (rtos (cadr m) 2 0) " Ad")))
        (prompt (strcat "\nTotal: " (rtos (sslength b) 2 0) " Ad")) (textpage)
      ) (alert "Block object was not found")
    )
  ) (princ)
)

19.12.2015 22:48    

defikol
Hocam eline sağlık çok işime yarayacak. Teşekkürler

20.12.2015 10:37    

defikol
Hocam çok güzel sayıyor ama bazı blokların ismi örneğin j200 ama aşağıda *U21 yazıyor. neden böyle yapıyor anlamadım.

20.12.2015 11:33    

alumina
Alıntı
defikol :



Haklisin. Dinamik bloklari dusunmedik tabi :)

Kod:

(defun c:bn (/ p b i sr bn l m) (vl-load-com)
  (if (setq p (ssget ":s" '((0 . "*polyline") (70 . 1))))
    (if (setq b (ssget "wp" (mapcar 'cdr (vl-remove-if-not '(lambda(a) (= (car a) 10))
          (entget (ssname p 0)))) (list (cons 0 "insert"))))
      (progn
        (repeat (setq i (sslength b))
          (if (setq sr (vl-position (setq bn (vla-get-EffectiveName
                (vlax-ename->vla-object (ssname b (setq i (1- i))))))
                (mapcar '(lambda(b) (car b)) l)))
            (setq l (subst (list (car (nth sr l)) (1+ (cadr (nth sr l)))) (nth sr l) l))
            (setq l (cons (list bn 1) l))))
        (foreach m (vl-sort l '(lambda (x y) (< (car x) (car y))))
          (princ (strcat "\n" (car m) ": " (rtos (cadr m) 2 0) " Ad")))
        (prompt (strcat "\nTotal: " (rtos (sslength b) 2 0) " Ad")) (textpage)
      ) (alert "Block object was not found")
    )
  ) (princ)
)

20.12.2015 11:56    

defikol
Hocam çok zahmet verdik... eline sağlık çok güzel olmuş. Tam istediğim gibi.:)

25.12.2015 14:39    

defikol
Hocam bir birine sınır iki adet kapalı polyline alanını tam sınır çizgisinde blok olunca ( yani blogun bir kısmı bir alanda kalırken bir kısmı da diğer kapalı polyline içinde kalmaktadır). Bu durumda blogu saymamakta. Acaba böyle bir durumda blogun base pointi hangi polyline içinde kalıyorsa o alandaki bloklarla beraber sayabilir mi, veya blogun büyük parçası hangi alanda kalıyorsa o kapalı polyline içinde sayabilir mi?

26.12.2015 07:44    

alumina
Alıntı
defikol :



1- Blogun insert noktasi tam sinir cizgisi uzerindeyse ?
2- Blok tam olarak yari yariya polyline lerin icinde kalirsa ?

Bence bloklari yerlestirirken azicikta olsa dikkat et. Yukarda yazdigim kodda, blok tamamiyla polyline icinde kalirsa isleme alinir. Eger blogun polyline cizgisini kestigi durumlarda da isleme alinmasi istenirse,

Kod:

(ssget "wp".......


satirindaki "wp" yerine "cp" yazilir. Bu durumda blok, her iki polyline cizgisinide keserse, yine her iki polyline icinde isleme alinir.

26.12.2015 12:34    

defikol
Hocam blok yerleştirirken bazen sınıra yerleştirmemiz gerekiyor. Base pointi yerini ayarlayabilirim veya büyük kısmını sadece bir tarafta kalmasını sağlayabilirim. Ben saydırmadan önce bütün çizimi kopyalıyorum sonra kopya üzerinde sınırda kalan blokları tek tek kapalı polyline içine çekip sonra saydırıyorum. Bilmiyorum eğer yapılma ihtimali varsa. Gerçi bu emeğiniz bile benim için nimet.

> 1 <
Copyright © 2004-2022 SQL: 1.296 saniye - Sorgu: 66 - Ortalama: 0.01963 saniye