AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
22.08.2023 22:09    

Buraksait
İnstagramda gezerken karşıma çıkan bir lisp var. Sanırım Yqarch da mevcutmuş. Bu lispi yazma konusunda yardımcı olabilirseniz çok sevinirim.

Eğer mümkünse çoklu şecimde en yakın 2 line, veya çakışan 2 line aralarında yapabilir mi?





Linkleri görebilmek için ÜYE olmalısınız.




Teşekkür ederim.

24.08.2023 06:11    

baha07
merhaba ,
daha iyisini bulana kadar simdilik bu isini gorebilir ..

Kod:

;Line ve pline hatlarin birbiriyle kesisimine kadar uzatir yada keser (ucuca ekler)
;ilk hat demetinin uzerini ciz , ikinci hat demetinin uzerini ciz - icten yada distan baglanmasini istiyorsan  - icten icin enter bas  yada distan icin out (o) yaz
; iki hat demetindeki hatlarin sayisi birbirine esit olmali  aksi takdirde  lisp calismiyor
;jtm2020hyo and Sea-Haven
(defun c:mfillet (/ pt1 pt2 pt3 pt4 obj1 obj2 lst1 lst2 lst dist1 dist2 x ss ss2)
  (setq pt1 (getpoint "Pick outside"))
  (setq pt2 (getpoint pt1 "Pick inside"))
  (setq pt3 (getpoint pt2 "Pick outside"))
  (setq lst (list pt1 pt2))
  (setq ss (ssget "F" lst (list (cons 0 "*line"))))
  (setq lst (list pt2 pt3))
  (setq ss2 (ssget "F" lst (list (cons 0 "*line"))))
  (if (= (sslength ss) (sslength ss2))
    (progn
      (command "line" pt1 pt2 "")
      (setq obj1 (vlax-ename->vla-object (entlast)))
      (command "Line" Pt2 pt3 "")
      (setq obj2 (vlax-ename->vla-object (entlast)))
      (setq lst1 '())
      (repeat (setq x (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
        (setq pt4 (vlax-invoke obj1 'intersectWith obj acExtendThisEntity))
        (setq dist1 (distance pt2 pt4))
        (setq lst1 (cons (list dist1 pt4) lst1))
      )
      (setq lst1 (vl-sort lst1
                          (function (lambda (e1 e2)
                                            (< (car e1) (car e2))
                                    )
                          )
                 )
      )
      (setq lst2 '())
      (repeat (setq x (sslength ss2))
        (setq obj (vlax-ename->vla-object (ssname ss2 (setq x (- x 1)))))
        (setq pt4 (vlax-invoke obj2 'intersectWith obj acExtendThisEntity))
        (setq dist1 (distance pt2 pt4))
        (setq lst2 (cons (list dist1 pt4) lst2))
      )
      (setq lst2 (vl-sort lst2
                          (function (lambda (e1 e2)
                                            (< (car e1) (car e2))
                                    )
                          )
                 )
      )
      (vla-delete obj1)
      (vla-delete obj2)
      (Setq choice (getstring "\n Press Enter for In any key for out"))
      (if (= choice "") (setq lst1 (reverse lst1)))
      (setvar 'filletrad 0.0)
      (setq x 0)
      (repeat (sslength ss)
        (setq pt1 (cadr (nth x lst1)))
        (setq pt2 (cadr (nth x lst2)))
        (command "._FILLET" pt1 pt2)
        (setq x (+ x 1))
      )
    )
  )
  (princ)
)

baha07 (24.08.2023 06:56 GMT)

24.08.2023 10:01    

Buraksait
Eline sağlık

25.08.2023 00:22    

ProhibiT


Linkleri görebilmek için ÜYE olmalısınız.

> 1 <
Copyright © 2004-2022 SQL: 1.28 saniye - Sorgu: 57 - Ortalama: 0.02246 saniye