08.05.2015 13:22    

alpayelmas
aşşağıdaki kod ile sayfadaki tüm lineleri seçiyorum bazen ; error: bad argument type: 2D/3D point: nil hatası verıyor nasıl duzeltebılırım acaba

Kod:

;;; This function writes length of all selected polylines, lines, arcs etc
;;; and writes the length at their mid point
(defun c:boyyaz (/ cnt obj ss midpt len tp1 tp2 ang)

(command "_.Layer" "_Make" "001-Kalip Metraj" "_Color" "20" "" "LType" "Continuous" "" "")
(setq oldlayer (getvar "CLAYER")) ; get current layer
(setvar "CLAYER" "001-Kalip Metraj")

  (setq ss (ssget (list (cons 0 "POLYLINE,ARC,LINE,LWPOLYLINE,2DPOLYLINE"))))
    (initget (+ 1 2 4))
    ;check user input
    ;(setq sc (getdist "\nEnter Text Height : "))
(setq sc 0.1)
    ;get the text height

    ;check user input
    ;(setq ndg (getint "\nEnter No of digits : "))
(setq ndg 2)
    ;get the text height
   (setq cnt (sslength ss))

  (repeat cnt
 
   
    (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
    (if (vlax-property-available-p obj 'arclength)
      (setq len (/ (vla-get-arclength obj) 2.0))
      (setq len (/ (vla-get-length obj) 2.0))
    );APE
    (setq midpt (vlax-curve-getPointAtDist obj len)
          tp1   (vlax-curve-getPointAtDist obj (+ len 0.1))
          tp2   (vlax-curve-getPointAtDist obj (- len 0.1))
          ang   (* (angle tp2 tp1) (/ 180.0 pi))
    )


(command "text" "J" "TC" midpt 0.05 ang (rtos (* len 2.0) 2 ndg) "")


 

  )
 
 
(setvar "CLAYER" oldlayer) ;restore active layer
)

08.05.2015 13:38    

ehya
Nesne seçimi yapılmadığında hata verir.
Ayrıca en altta text kısmınd sondaki "" işareti fazla.

08.05.2015 14:39    

alpayelmas
Tüm çizimi seçtiğimde bazı line lardan kaynaklı olarak verıyor bu hatayı

08.05.2015 15:18    

ehya
Doğru yazılmış bir lisp değil zaten.
Lisp yazmayı az çok biliyorsunuz. Bu tür durumlarda başkasının yazdığı lispi kullanmak yerine kendiniz yazmalısınız.

08.05.2015 15:30    

alpayelmas
Ehya bey çok acil lazım olmuştu , işimi tam istediğim gibi olmasada hallettim ama yinede bu hatalarla kendi lisplerimde de karşılaştığım oluyor. Eminim yukarıdaki kodların yarısı daha kestirme bir yoldan halledilirdi. bir boşlukta yazıp paylaşırım.

08.05.2015 15:32    

alpayelmas
Aslında kalıp metrajı için çok kapsamlı bir lisp üzerinde çalışıyorum. büyük oranda çözdüm ama çok kullanışlı olmuyor kalıp demir gibi attrib veya standart lyerler üzerine kurulu olmuyor yada metraja müsayit standart bir yapıda olmuyor. bu aksam veya yarın yeni bir baslık altında konu açıp paylaşacağım belki bir kaç arkadaş ortaklaşa herkezin kullanımına bir katkı sağlayacak bir kod oluşturabiliriz.
Selamlar.

22.05.2015 07:48    

alpayelmas
Merhaba;
Projelerimde Mpi_KOL ve Mpi_KOLIZ layerlerinde %95 'i dikdörtgen veya kare çizilmiş kolonlarım var. Bunları sayıp eni boyu şudur diye tablo veren bir lisp'e ihtiyacım var. Yamuk olan kolon veya çok kenarlı perdelerin yazılmasına gerek yok bir kaç adet oldukları için kendim elle yazabılırım.

Yardımlarınız için şimdiden çok teşekkürler

23.05.2015 09:05    

alpayelmas
Kod:

;;Counting rectangles.
;;Stefan M., 11.feb.2015
;;color counting 04.mar.2015
(defun rectangle_dims (e / l a b)
  (setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) e)))
  (if
    (and
      (or
        (= 1 (logand (cdr (assoc 70 e)) 1))
        (equal (car l) (last l) 1e-8)
      )
      (equal (distance  (car   l) (caddr l)) (distance  (cadr   l) (cadddr l)) 1e-8)
      (equal (mapcar '- (cadr  l) (car   l)) (mapcar '- (caddr  l) (cadddr l)) 1e-8)
      (equal (mapcar '- (caddr l) (cadr  l)) (mapcar '- (cadddr l) (car    l)) 1e-8)
    )
    (vl-sort (list (distance (car l) (cadr l)) (distance (cadr l) (caddr l))) '<)
  )
)

(defun C:RECDIMS (/ *error* ss e old r p1 c)
  (vl-load-com)
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )
  (vla-startundomark acDoc)
 
  ;;;;;; Error function ;;;;;;;;;
  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nError: " msg))
      )
    (vla-endundomark acDoc)
    (princ)
    )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              c (cond
                  ((cdr (assoc 62 (entget e))))
                  ((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 (entget e)))))))
                )
              c (if (zerop c) 7 c)
              )
        (if
          (and
            (setq dims (rectangle_dims (entget e)))
            (setq dims (cons c dims))
            )
          (if
            (setq old (vl-some '(lambda (d) (if (equal (cdr d) dims 1e-8) d)) r))
            (setq r (subst (cons (1+ (car old)) dims) old r))
            (setq r (cons  (cons 1 dims) r))
          )
        )
      )
      (if
        (and r (setq p1 (getpoint "\nSpecify table insert point: ")))
        (insert_table
          (vl-sort
            (vl-sort
              (vl-sort
                (mapcar '(lambda (a) (list (cadr a) (caddr a) (cadddr a) (car a))) r)
                '(lambda (a b) (< (caddr a) (caddr b)))
                )
              '(lambda (a b) (< (cadr a) (cadr b)))
             )
            '(lambda (a b) (< (car a) (car b)))
          )
          p1
          )       
         )
       )
    )
  (princ)
)

;;The textheight in table depends on cannonscale
(defun insert_table (lst pct / tab row col ht i n acol)
  (setq ht  (/ 2.5 (getvar 'cannoscalevalue))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) 3 (* 1.5 ht) ht))
        acol (vla-getinterfaceobject acobj  (strcat "AutoCAD.AcCmColor." (substr (vla-get-version acobj) 1 2)))
        )
  (vlax-put tab 'direction n)
 
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
 
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons '(nil "Width" "Length" "Pcs.") lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list (mapcar 'cdr lst)))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
 
  (setq lst (cons '(nil "RECTANGLES") lst))
 
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c (cdr r)
      (vla-SetText tab row col (vl-princ-to-string c))
      (if
        (car r)
        (progn
          (if (/= (vla-get-colorindex acol) (car r)) (vla-put-colorindex acol (car r)))
          (vla-SetCellContentColor tab row col acol)
          )
        )
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )
 
(princ "\nType RECDIMS to start the command")

25.05.2015 05:57    

alirizasahin
Sıhhi tesisat projesi çizen arkadaşlara yardımcı olunması için aşağıda verdiğim lispe dirsek, çatal vs. fittingsler eklenebilir mi? Böyle bir lispe tesisat işi ile uğraşanların çok ihtiyacı olacak diye düşünüyorum.

(Lisp Alıntıdır.)

Kod:

;|      DP.LSP  JD HENMAN 20090818
DP - draws pipe the length of selected lines (centerlines)
             (use along with pull-down menu for all Std pipe sizes
|;
(defun c:DP (/ olayer lay_name A B C D E N1 N2 pnt11 pnt12 mssg dist dist2 entity count total)

; load the vla command set
  (vl-load-com)

; accessing the graphic screen as opposed to the text screen
  (graphscr)

; remember the current layer
  (setq olayer (getvar "clayer"))

; define the layers addressed in the program
   (command "layer" "m" "Center" "c" "2" "" "lt" "Center2" "" "")
   (command "layer" "m" "Hidden" "c" "142" "" "lt" "Hidden2" "" "")
   (command "layer" "m" "Object" "c" "3" "" "lt" "Continuous" "" "")
   (setvar "clayer" olayer)

; let user specify OD & ID
(setq P-OD (getreal "\n Enter O.D. of Pipe: "))
(setq P-ID (getreal "\n Enter I.D. of Pipe: "))
(setq P-OD_2 (/ P-OD 2))
(setq P-ID_2 (/ P-ID 2))

;|  SECTION BLOCKED
; this portion filters only lines on layer PC
   (setq lay_name "PC")

; note: ssget "X" even selects objects on layers turned off, locked or frozen!
   (setq A (ssget "X"
           (list (cons 0 "LINE") (cons 8 lay_name))
           )
   );setq A

; END SECTION BLOCKED
|;
  (princ "\n Warning! Arc/Splines CL's Return Incorrect Length.\nSelect Centerlines to Construct Pipe: ")
   (setq A (ssget))

;variable B knows how many objects were found in variable A
   (setq B (sslength A))

   (setq C 0); counter

; the loop ends when C = B
   (while (< C B)

;  command line animation to prove computer is working:
   (defun spinbar (sbar)
     (cond
          ((= sbar "") "|")
          ((= sbar "|") "/")
          ((= sbar "/") "-")
          (t "")
      );cond
   );defun

   (princ (strcat "\rOffsetting Pipe Entities " (setq sbar (spinbar sbar))))

; D is assigned the next entity found in the subset
      (setq D (ssname A C))

      (initget (+ 1 2 4 64))
      (setq odist P-OD_2); distance for offsets
      (setq idist P-ID_2); distance for offsets

; D is the entity but must be considered an object to be offset
      (setq D (vlax-ename->vla-object D))

; D is offset in both directions everything to be on Pipe layer
      (vla-offset D idist)
        (setq entity (entlast)
              entity (entget entity)
              entity (subst (cons 8 "Hidden")
             (assoc 8 entity) entity)
         );setq
         (entmod entity)
      (vla-offset D (* idist -1))
        (setq entity (entlast)
              entity (entget entity)
              entity (subst (cons 8 "Hidden")
             (assoc 8 entity) entity)
         );setq
         (entmod entity)
      (vla-offset D odist)
        (setq entity (entlast)
              entity (entget entity)
              entity (subst (cons 8 "Object")
             (assoc 8 entity) entity)
         );setq
         (entmod entity)
      (vla-offset D (* odist -1))
        (setq entity (entlast)
              entity (entget entity)
              entity (subst (cons 8 "Object")
             (assoc 8 entity) entity)
         );setq
         (entmod entity)
(setq C (1+ C));add one to counter before testing while loop again
) ;while

; Now to calculate the same selection sets total length in Feet & Inches.
   (setq E (ssget "P"))
  (setq total 0)
  (setq count (sslength E))
(while (/= count 0)
(setq N1 (ssname E 0))
(setq N2 (entget N1)
              N2 (subst (cons 8 "Center")
             (assoc 8 N2) N2)
        );setq
(setq pnt10 (cdr (assoc 10 N2)))
(setq pnt11 (cdr (assoc 11 N2)))
(setq dist2 (distance pnt10 pnt11))
(setq total (+ dist2 total))
(ssdel N1 E)
        (entmod N2)
(setq count (1- count))
);end while
        (setq mssg (strcat " Finished!  " "\n Length of Pipe = " (rtos total 4 2)))
        (prompt mssg)
  (princ)
);defun DP

ehya (25.05.2015 06:42 GMT)

25.05.2015 07:40    

halilozcakir
Lispi yüklüyorum komut satırına DP yazıyorum bana OD ve ID of pipe değerleri istiyor verince seçtiğim çizgileri eksen çizgisine dönüştürüyor, verdiğim iki değer kadar ofset atıyor , bu ne işimize yarayacak başka neler yapıyor anlamadım?

25.05.2015 08:31    

alirizasahin
Bu lispi sıhhi tesisat kolon şemasında pissu kolon hatları ve pissu rögar bağlantılarında kullanıyorum.
Sitedeki havalandırma lispi gibi kullanarak bu lispe fittings eklenebilir mi?
Maşon, dirsek, çatal, te parçası gibi...

alirizasahin (25.05.2015 08:39 GMT)

25.05.2015 10:19    

isahidrodinamik
Autocad sayfası içerisinde bir den fazla çizimciklerim mevcut. Her birini tek tek hazırladığım antetlere yerleştirip, anteti çizime göre scale edip yerleştirmek çok fazla zamanımı almakta. Benim istediğim ise dosya içersinde çizmiş olduğum herhangi bir objeyi yada seçtiğim alanı otomatik olarak antet içine alabilcek bi lisp yazılması mümkünmüdür. Çizilen objenin scalesi önemli değil sonuç olarak A4' e ölçeksiz çıktı alıyorum.

28.05.2015 06:46    

halilozcakir
merhabalar üstadlar , autocadteki yazıyı çarpıp yazacak bir lisp lazım oldu , layer isolete ile tek yazıları bırakıp komple seçebiliriz..
örneğin ,autocad te 100 kg/h yazıyor ona tıklayınca 4000 w yazacak , çarpanı biz belirleyeceğiz , sonuna yazı ekini de biz vereceğiz , lisp çarpma işlemini yapıp verdiğimiz birim harf değeri ile beraber yazıyı değiştirecek.
bir nevi birim çevir anlayacağınız..

halilozcakir (28.05.2015 06:53 GMT)

28.05.2015 23:58    

alumina
Alıntı
halilozcakir :
merhabalar üstadlar , autocadteki yazıyı çarpıp yazacak bir lisp lazım oldu , layer isolete ile tek yazıları bırakıp komple seçebiliriz..
örneğin ,autocad te 100 kg/h yazıyor ona tıklayınca 4000 w yazacak , çarpanı biz belirleyeceğiz , sonuna yazı ekini de biz vereceğiz , lisp çarpma işlemini yapıp verdiğimiz birim harf değeri ile beraber yazıyı değiştirecek.
bir nevi birim çevir anlayacağınız..



Kod:

(defun c:tx (/ ss cr ek i ob sn) (vl-load-com)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg)))
    (princ))
  (if (setq ss (ssget '((0 . "text"))))
    (if (setq cr (getreal "\nCarpan:"))
      (progn
        (setq ek (getstring "\nBirim:"))
        (repeat (setq i (sslength ss))
          (setq ob (vlax-ename->vla-object (ssname ss (setq i (1- i))))
                sn (strcat (rtos (* (atof (vla-get-TextString ob)) cr) 2 2) " " ek))
          (vla-put-TextString ob sn))
      )
    )
  ) (princ)
)

29.05.2015 05:11    

halilozcakir
çok teşekkür ederiz üstad. Yolun Sabiha Gökçen Havalimanı , HABOM a düşerse bir çay kahve içelim.

29.05.2015 06:47    

alumina
Alıntı
halilozcakir :
çok teşekkür ederiz üstad. Yolun Sabiha Gökçen Havalimanı , HABOM a düşerse bir çay kahve içelim.



Yorma simdi beni. Bir ara Guzelyali'da oturur içeriz :)

30.05.2015 07:55    

proje86
selamlar,
koordinatı girilen bir noktadan 100 br sağa doğru çizgi çizen basit bir lispe ihtiyacım var.

30.05.2015 08:39    

alumina
Alıntı
proje86 :
selamlar,
koordinatı girilen bir noktadan 100 br sağa doğru çizgi çizen basit bir lispe ihtiyacım var.



Kod:

(defun c:ln (/ pt)
  (if (setq pt (getpoint "\nPoint:"))
    (entmake (list (cons 0 "line") (cons 10 pt) (cons 11 (polar pt 0 100)))))
  (princ)
)

30.05.2015 08:49    

proje86
Alıntı
alumina :
Alıntı
proje86 :
selamlar,
koordinatı girilen bir noktadan 100 br sağa doğru çizgi çizen basit bir lispe ihtiyacım var.



Kod:

(defun c:ln (/ pt)
  (if (setq pt (getpoint "\nPoint:"))
    (entmake (list (cons 0 "line") (cons 10 pt) (cons 11 (polar pt 0 100)))))
  (princ)
)




teşekkürler.

01.06.2015 13:40    

alpayelmas
Merhaba Arkadaşlar.
Şantiyede kolon perde ölçülerim her katta değişiyor bu nedenle kullandığım panel kalıplarımın çizimlerimi sürekli revize etmem gerekiyor. Kullandıgım panoların ölçüleri standart ve block lanmış olarak mevcut . yapmam gereken blok adını komut olarak lisp e vermek ( 60pano) ve bu blogu alıp otomatık olarak sectiğim çizgiye göre dondurmek . örnek bir dosya ekliyorum . yarcı olabılırmısınız?

ornek dosya



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



yanlızca 1 blogu kopyalayıp dondurse bıle yeterlı ben kodu duzenleyebılırım.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] [50] [55] [60] > 64 < [65] [70] [75] [80] [85] [90] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.199 saniye - Sorgu: 98 - Ortalama: 0.01223 saniye