Point-text iletişimi | Forumlar

AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim

aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A

Forumlar > AutoLISP > Point-text iletişimi

20.03.2024 17:37

macros55

İyi günler arkadaşlar,

Çizimde dağnık halde pointler ve textler var.
Lisp yardımı ile textleri noktalarla aynı konuma getirmek olurmu?

Ornek:
1) Select all text ->
2) Test1 enter ->
3)soru: text ne kadar uzaklıkdakı pointe konumlansın? [1.0m] enter
4) seçilen textler yakaladıkları pointlerle aynı konumlara gitsin.
5) soru: işlem uyğulanan ponitler ve textler yeni layere gitsin? Yes/No [layer name] enter

Önceden tesekkurler.

90656

22.03.2024 05:12

mttlp

Yapılır

90658

24.03.2024 00:08

alumina

Alıntı
macros55 :

"Enter the layer name:" iletisinde layer adi girilirse create edilen pointler ve islem yapilan textler girilen layer adinda olur, enterle veya sag tus ile pas gecilirse aktif layerde olur..

Kod:

(defun c:qw (/ dc ss ln lm e k s0 ts t0 tn tp ld ls)
(vl-load-com)
(if (and (setq dc (vla-get-ActiveDocument
(vlax-get-acad-object))
ss (ssget '((0 . "LwPolyline") (8 . "hat"))))
(setq ln (getstring T "\nEnter the layer name:")))
(progn (vla-StartUndomark dc)
(repeat (setq k (sslength ss))
(setq k (1- k)
s0 (ssname ss k)
ts (ssget "_X" '((0 . "*Text") (8 . "Kot")))
ls nil)
(repeat (setq e (sslength ts))
(setq e (1- e)
t0 (ssname ts e)
tn (entget t0)
tp (cdr (assoc 10 tn))
ls (cons (list (distance tp
(vlax-curve-getClosestPointTo
(vlax-ename->vla-object s0) tp T)) tp
(atof (getpropertyvalue t0
(if (= (cdr (assoc 0 tn)) "MTEXT")
"Text" "TextString"))) t0) ls))
)
(setq ld (car (vl-sort ls '(lambda(a b)
(< (car a) (car b)))))
lm (if (= ln "") (getvar "Clayer") ln)
tm (entget (nth 3 ld)))
(entmake (list '(0 . "Point") (cons 8 lm)
(cons 10 (append (cadar (vl-sort (mapcar '(lambda(a)
(list (distance (cadr ld) a) a))
(mapcar 'cdr (vl-remove-if '(lambda(x)
(/= (car x) 10)) (entget s0))))
'(lambda(a b) (> (car a) (car b)))))
(list (caddr ld))))))
(entmod (subst (cons 8 lm) (assoc 8 tm) tm))
) (vla-EndUndomark dc)
)
) (prin1)
)

90659

24.03.2024 07:54

macros55

Hocam çok teşekkür ederim ellinize sağlık super olmuş.

90678

10.04.2024 14:43

baha07

selamlar ,
bayraminiz mubarek olsun . ben bu lispi calistirdim ama nesne secimi yapamiyorum ne mtext ne point

eksik bir sey mi yapiyorum ? ilk asamada hangi nesneyi sececegim

Alıntı
alumina :

Alıntı
macros55 :

"Enter the layer name:" iletisinde layer adi girilirse create edilen pointler ve islem yapilan textler girilen layer adinda olur, enterle veya sag tus ile pas gecilirse aktif layerde olur..

Kod:

(defun c:qw (/ dc ss ln lm e k s0 ts t0 tn tp ld ls)
(vl-load-com)
(if (and (setq dc (vla-get-ActiveDocument
(vlax-get-acad-object))
ss (ssget '((0 . "LwPolyline") (8 . "hat"))))
(setq ln (getstring T "\nEnter the layer name:")))
(progn (vla-StartUndomark dc)
(repeat (setq k (sslength ss))
(setq k (1- k)
s0 (ssname ss k)
ts (ssget "_X" '((0 . "*Text") (8 . "Kot")))
ls nil)
(repeat (setq e (sslength ts))
(setq e (1- e)
t0 (ssname ts e)
tn (entget t0)
tp (cdr (assoc 10 tn))
ls (cons (list (distance tp
(vlax-curve-getClosestPointTo
(vlax-ename->vla-object s0) tp T)) tp
(atof (getpropertyvalue t0
(if (= (cdr (assoc 0 tn)) "MTEXT")
"Text" "TextString"))) t0) ls))
)
(setq ld (car (vl-sort ls '(lambda(a b)
(< (car a) (car b)))))
lm (if (= ln "") (getvar "Clayer") ln)
tm (entget (nth 3 ld)))
(entmake (list '(0 . "Point") (cons 8 lm)
(cons 10 (append (cadar (vl-sort (mapcar '(lambda(a)
(list (distance (cadr ld) a) a))
(mapcar 'cdr (vl-remove-if '(lambda(x)
(/= (car x) 10)) (entget s0))))
'(lambda(a b) (> (car a) (car b)))))
(list (caddr ld))))))
(entmod (subst (cons 8 lm) (assoc 8 tm) tm))
) (vla-EndUndomark dc)
)
) (prin1)
)

> 1 <


	Forum	Download	Galeri	Üye Ol \| Giriş