Beğenmek için anlamak lazım...

Beğenmek için anlamak lazım...

ProhibiT (24.05.2012 06:07 GMT)

Beğenmek için anlamak lazım...

***TAKDİR EDİLİYORSAN DEĞİL,TAKLİT EDİLİYORSAN BAŞARMIŞSIN DEMEKTİR***

Alıntı

---

emasi :
Herkese selam
Bende şöyle bir lisp mövcut objenin ağırlık merkezini buluyor ve merkeze nokta koyuyor. P.S.-- lisp benim deyil ve nereden götürdüyümü hatırlamıyorum :blush

Kod:

(defun c:qw (/)
  (vl-load-com)
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vla-get-ActiveDocument acadObject))
  (setq numSpace (vla-get-ActiveSpace acadDocument))
  (cond ((= numSpace 1)
(setq ActSpace (vla-get-ModelSpace acadDocument))
)
((= numSpace 0)
(setq ActSpace (vla-get-PaperSpace acadDocument))
)
  )
  (setq sset (ssget '((-4 . "<OR")
      (0 . "CIRCLE")
      (0 . "ELLIPSE")
      (-4 . "<AND")
      (0 . "LWPOLYLINE")
      (70 . 1)
      (-4 . "AND>")
      (0 . "REGION")
      (-4 . "OR>")
     )
     )
  )
  (setq count   (sslength sset)
i   0
n   0
m   0
k   0
summX   0
summY   0
summareas 0
listX   (list)
listY   (list)
listAreas (list)
  )
  (while (<= i (1- count))
    (setq objType (cdr (assoc 0 (entget (ssname sset i)))))
    (setq Obj (vlax-ename->vla-object (ssname sset i)))
    (if (= objType "LWPOLYLINE")
      (progn
(setq vla_region
  (car (vlax-safearray->list
(vlax-variant-value
   (vla-addregion
     (vla-objectidtoobject
       (vla-get-document
Obj
       )
       (vla-get-ownerid
Obj
       )
     )
     (vlax-safearray-fill
       (vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length (list Obj))))
       )
       (list Obj)
     )
   )
)
       )
  )
      centerPtLst
  (vlax-safearray->list
    (vlax-variant-value (vla-get-centroid vla_region))
  )
      CurrArea
  (vla-get-Area vla_region)
)
(setq ListX (append ListX (list (car centerPtLst)))
      ListY (append ListY (list (cadr centerPtLst)))
      ListAreas (append ListAreas (list CurrArea))
)
(vla-delete vla_region)
      )
    )
    (if (= objType "REGION")
      (progn
(setq centerPtLst
  (vlax-safearray->list
    (vlax-variant-value (vla-get-centroid Obj))
  )
      CurrArea
  (vla-get-Area obj)
)
(setq ListX (append ListX (list (car centerPtLst)))
      ListY (append ListY (list (cadr centerPtLst)))
      ListAreas (append ListAreas (list CurrArea))
)
      )
    )
    (if (or (= objType "CIRCLE") (= objType "ELLIPSE"))
      (progn
(setq centerPtLst
  (vlax-safearray->list
    (vlax-variant-value (vla-get-center Obj))
  )
      CurrArea
  (vla-get-Area obj)
)
(setq ListX (append ListX (list (car centerPtLst)))
      ListY (append ListY (list (cadr centerPtLst)))
      ListAreas (append ListAreas (list CurrArea))
)
      )
    )
    (setq i (1+ i))
  )
  (setq summXlist (mapcar '* ListX ListAreas)
summYlist (mapcar '* ListY ListAreas)
  )
  (foreach n summXList (setq summX (+ summX n)))
  (foreach m summYList (setq summY (+ summY m)))
  (foreach k ListAreas (setq summAreas (+ summAreas k)))
  (setq centerPtList (list (/ summX summAreas) (/ summY summAreas) 0)
pointCoord   (ptnList->variantArray centerPtList)
PointObj     (vla-addPoint ActSpace pointCoord)
  )
  (princ)
)
(defun ptnList->variantArray (ptsList / arrayActSpace sArray)
  (setq arrayActSpace
(vlax-make-safearray
   vlax-vbdouble
   (cons 0
(- (length ptsList) 1)
   )
)
  )
  (setq sArray (vlax-safearray-fill arrayActSpace ptsList))
  (vlax-make-variant sArray)
)

Eyer çalışmasa şuradan indire bilirsiniz http://www.boxca.com/cj61ekdlhpjc/centre.lsp.html

---

Alıntı

---

atillaözel6666 :

Alıntı

---

emasi :
Herkese selam
Bende şöyle bir lisp mövcut objenin ağırlık merkezini buluyor ve merkeze nokta koyuyor. P.S.-- lisp benim deyil ve nereden götürdüyümü hatırlamıyorum :blush

Kod:

(defun c:qw (/)
  (vl-load-com)
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vla-get-ActiveDocument acadObject))
  (setq numSpace (vla-get-ActiveSpace acadDocument))
  (cond ((= numSpace 1)
(setq ActSpace (vla-get-ModelSpace acadDocument))
)
((= numSpace 0)
(setq ActSpace (vla-get-PaperSpace acadDocument))
)
  )
  (setq sset (ssget '((-4 . "<OR")
      (0 . "CIRCLE")
      (0 . "ELLIPSE")
      (-4 . "<AND")
      (0 . "LWPOLYLINE")
      (70 . 1)
      (-4 . "AND>")
      (0 . "REGION")
      (-4 . "OR>")
     )
     )
  )
  (setq count   (sslength sset)
i   0
n   0
m   0
k   0
summX   0
summY   0
summareas 0
listX   (list)
listY   (list)
listAreas (list)
  )
  (while (<= i (1- count))
    (setq objType (cdr (assoc 0 (entget (ssname sset i)))))
    (setq Obj (vlax-ename->vla-object (ssname sset i)))
    (if (= objType "LWPOLYLINE")
      (progn
(setq vla_region
  (car (vlax-safearray->list
(vlax-variant-value
   (vla-addregion
     (vla-objectidtoobject
       (vla-get-document
Obj
       )
       (vla-get-ownerid
Obj
       )
     )
     (vlax-safearray-fill
       (vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length (list Obj))))
       )
       (list Obj)
     )
   )
)
       )
  )
      centerPtLst
  (vlax-safearray->list
    (vlax-variant-value (vla-get-centroid vla_region))
  )
      CurrArea
  (vla-get-Area vla_region)
)
(setq ListX (append ListX (list (car centerPtLst)))
      ListY (append ListY (list (cadr centerPtLst)))
      ListAreas (append ListAreas (list CurrArea))
)
(vla-delete vla_region)
      )
    )
    (if (= objType "REGION")
      (progn
(setq centerPtLst
  (vlax-safearray->list
    (vlax-variant-value (vla-get-centroid Obj))
  )
      CurrArea
  (vla-get-Area obj)
)
(setq ListX (append ListX (list (car centerPtLst)))
      ListY (append ListY (list (cadr centerPtLst)))
      ListAreas (append ListAreas (list CurrArea))
)
      )
    )
    (if (or (= objType "CIRCLE") (= objType "ELLIPSE"))
      (progn
(setq centerPtLst
  (vlax-safearray->list
    (vlax-variant-value (vla-get-center Obj))
  )
      CurrArea
  (vla-get-Area obj)
)
(setq ListX (append ListX (list (car centerPtLst)))
      ListY (append ListY (list (cadr centerPtLst)))
      ListAreas (append ListAreas (list CurrArea))
)
      )
    )
    (setq i (1+ i))
  )
  (setq summXlist (mapcar '* ListX ListAreas)
summYlist (mapcar '* ListY ListAreas)
  )
  (foreach n summXList (setq summX (+ summX n)))
  (foreach m summYList (setq summY (+ summY m)))
  (foreach k ListAreas (setq summAreas (+ summAreas k)))
  (setq centerPtList (list (/ summX summAreas) (/ summY summAreas) 0)
pointCoord   (ptnList->variantArray centerPtList)
PointObj     (vla-addPoint ActSpace pointCoord)
  )
  (princ)
)
(defun ptnList->variantArray (ptsList / arrayActSpace sArray)
  (setq arrayActSpace
(vlax-make-safearray
   vlax-vbdouble
   (cons 0
(- (length ptsList) 1)
   )
)
  )
  (setq sArray (vlax-safearray-fill arrayActSpace ptsList))
  (vlax-make-variant sArray)
)

Eyer çalışmasa şuradan indire bilirsiniz http://www.boxca.com/cj61ekdlhpjc/centre.lsp.html

---

---

Alıntı

---

atillaözel6666 :

---