Copyright © 2004-2022 SQL: 1.21 saniye - Sorgu: 60 - Ortalama: 0.02017 saniye
24.03.2024 18:24
macros55 |
Arkdaşlar iyi günler, elimde böyle bir lisp var. Seçilimiş objelerin ardından komutu çalıştırınca seçili olanlara dokunan tüm objeleri birlikte seçiyor. Fakat çizimde obje sayısı (line arc text point cogo point block bigi karışık objeler) çok olunca lisp komutu sonlandırmıyor. Sorunu nasıl çöze biliriz?
Kod: (defun c:ns (/ ss xs ls i ob n so)
(vl-load-com) (if (setq ss (ssget "_I")) (progn (setq xs (ssget "_x" (list (cons 410 (getvar 'CTAB)))) ls (ssadd) i (sslength ss) ) (repeat i (setq ls (ssadd (setq ob (ssname ss (setq i (1- i)))) ls)) (repeat (setq n (sslength xs)) (if (and (vlax-write-enabled-p (vlax-ename->vla-object (setq so (ssname xs (setq n (1- n)))) ) ) (not (minusp (cdr (assoc 62 (entget (tblobjname "Layer" (cdr (assoc 8 (entget so)))) ) ) ) ) ) (vlax-write-enabled-p (vlax-ename->vla-object ob)) (VxGetIntersZ0 (vlax-ename->vla-object ob) (vlax-ename->vla-object so) acExtendNone ) ) (setq ls (ssadd so ls)) ) ) ) (sssetfirst nil ls) (princ "\nSelect ") (princ (sslength ls)) (princ " primitives") ) (alert "Please, select primives first") ) (princ) ) ;;;; ;;;; -- Function VxGetInters ;;;; Returns all intersection points between two objects. ;;;; Copyright: ;;;; 2000 MENZI ENGINEERING GmbH, Switzerland ;;;; Arguments [Type]: ;;;; Fst = First object [VLA-OBJECT] ;;;; Nxt = Second object [VLA-OBJECT] ;;;; Mde = Intersection mode [INT] ;;;; Constants: ;;;; - acExtendNone Does not extend either object. ;;;; - acExtendThisEntity Extends the Fst object. ;;;; - acExtendOtherEntity Extends the Nxt object. ;;;; - acExtendBoth Extends both objects. ;;;; Return [Type]: ;;;; > List of points '((1.0 1.0 0.0)...[list] ;;;; > Nil if no intersection found ;;;; Notes: ;;;; - None ;;;; (defun VxGetIntersZ0 (Fst Nxt Mde / IntLst PntLst Fst1 Nxt1) (setq Fst1 (vla-copy Fst) Nxt1 (vla-copy Nxt) ) (foreach n '(1e99 -1e99) (vla-move Fst1 (vlax-3d-point (list 0 0 0)) (vlax-3d-point (list 0 0 n)) ) (vla-move Nxt1 (vlax-3d-point (list 0 0 0)) (vlax-3d-point (list 0 0 n)) ) ) (vl-catch-all-apply '(lambda () (setq IntLst (vlax-invoke Fst1 'IntersectWith Nxt1 Mde)) ) ) (vla-delete Fst1) (vla-delete Nxt1) (cond (IntLst (repeat (/ (length IntLst) 3) (setq PntLst (cons (list (car IntLst) (cadr IntLst) (caddr IntLst) ) PntLst ) IntLst (cdddr IntLst) ) ) ) (T nil) ) (reverse PntLst) )
|
28.03.2024 05:29
Travaci |
Kod: (ssget "_x" (list (cons 410 (getvar 'CTAB)))) bu kısmı aşağıdaki gibi seçmek istediğiniz nesneleri ekleyerek işlemi kısaltabilirsiniz. Kod: (ssget "_x" (list (cons 0 "LINE,ARC,CIRCLE")))
|
30.03.2024 22:49
macros55 |
Travaci Abi, cevapladığınız için teşekkür ederim.
Diğer objelerin hepsini tanıması için sizin yazdığınız kodun üzerine küçük bir ekleme yaptım, özellikle blockları yakalaması için ama "insert" ekledim. komut çalıştığında çok fazla zaman alıyor. Acaba bunu başka kısa yolu varmı? Kod: (ssget "_x" (list (cons 0 "LINE,POLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,insert")))
|
01.04.2024 08:02
Travaci |
Aşağıdaki gibi bütün çizimi değilde sadece seçilen nesneleri arayarak işlemi kısaltabilirsiniz.
Kod: (if (setq ss (ssget))
(progn (setq xs (ssget (list (cons 0 "LINE,POLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,INSERT")))
|
01.04.2024 21:35
macros55 |
Travaci abi,
kodu aynen uyguladım maalesef block tanımadı.
|
Travaci |
Bir sorun yok çalışıyor
POLYLINE değil LWPOLYLINE yazman gerekiyor Travaci (02.04.2024 05:12 GMT) |