Merhaba,
Adeko IntelliCAD 2009 kullanıcısıyım. Adeko IntelliCAD7.2 R2014 kurdum.
Eski versiyonda kullandığım ve Geometrik merkezi bulup işaretleyen LISP programı yeni versiyonda çalışmıyor.
;;;=============================================================================
;;; AÇIKLAMA
;;;
;;; Bu program, Geometrik merkezi tespit eder
;;;
;;;----------------------------------------------------------------------------
;From CADENCE Magazine March , 1991
;Page 106
(defun C:yy (/ MECHO CECHO ss1 ur ll dx magn EAi Eli Elixi Eliyi
Eli3 Elixi2 Eliyi2 Inax Inay Ixx Iyy width xname
tbdata ename elist n pt1 pt2 li Ai xi yi Xcg Ycg
cmass delta accu)
(progn
(setq mecho (getvar "MENUECHO")
cecho (getvar "CMDECHO"))
(setvar "MENUECHO" 5) ; No echo
(setvar "CMDECHO" 0)
(prompt "Sınırları oluşturan nesneleri seçin: ")
(setq ss1 (ssget)) ; Select area
(setq ur (car (getvar "VSMAX"))) ; x-coord of ur
(setq ll (car (getvar "VSMIN"))) ; x-coord of ll
(setq dx (abs (- ur ll))) ; dx is width of screen
(setq accu (getint "\nHassasiyet <600>: "))
(if (null accu) (setq accu 600))
(setq magn (/ dx accu)) ; magn controls accuracy, 200 to 600 gives-
; good results
;; Note : Higher numbers (magn lower) mean slower processing
;; but more accuracy!
(command "_.HATCH" "ANSI31" magn -45 ss1 "")
(prompt "Hesaplanıyor...")
(setq eli 0
elixi 0
eliyi 0
eai 0
eli3 0
eliyi2 0
elixi2 0)
(setq width (/ magn
) ; Width of slices
(setq xname (cdr (assoc 2 (entget (entlast)))))
(setq tbdata (tblsearch "BLOCK" xname))
(setq ename (cdr (assoc -2 tbdata)))
(setq elist (entget ename))
(setq n 1)
(while (entnext (cdr (assoc -1 elist))) ; Go through all lines in hatch
(setq elist (entget (entnext (cdr (assoc -1 elist)))))
(setq pt1 (cdr (assoc 10 elist))) ; One endpoint of hatch line i
(setq pt2 (cdr (assoc 11 elist))) ; Other endpoint of hatch line i
(setq li (distance pt1 pt2)) ; Length of slice
(setq ai (* width li)) ; Area of slice
(setq xi (/ (+ (car pt1) (car pt2)) 2)) ; x-coord. of CM of slice
(setq yi (/ (+ (cadr pt1) (cadr pt2)) 2)) ; y-coord. of CM of slice
(setq eai (+ eai ai)) ; Sum up area of slices
(setq eli (+ eli li)) ; Sum up lengths of slices
(setq eli3 (+ eli3 (* li li li))) ; Sum over (li * li * li * xi)
(setq elixi (+ elixi (* li xi))) ; Sum over (li * xi)
(setq eliyi (+ eliyi (* li yi))) ; Sum over (li * yi)
(setq elixi2 (+ elixi2 (* li xi xi))) ; Sum over (li * xi * xi)
(setq eliyi2 (+ eliyi2 (* li yi yi))) ; Sum over (li * yi * yi)
(if (= (rem n 70) 0)
(prompt ".")
) ; Show that program is working
(setq n (1+ n))
) ; End of while
(setq xcg (/ elixi eli)
ycg (/ eliyi eli)) ; Center of mass/area
(setq ixx (+ (/ (* width width width eli) 12) (* width eliyi2)))
(setq iyy (+ (/ (* width eli3) 12) (* width elixi2)))
(setq inax (- ixx (* eai ycg ycg))) ; Moment of Inertia around x-NA
(setq inay (- iyy (* eai xcg xcg))) ; Moment of Inertia around y-NA
(command "_.ERASE" "_L" "") ; Wipe out hatch
(prompt "Bitti\n\n")
(write-line "")
(setq cmass (strcat (rtos xcg 2 2) "," (rtos ycg 2 2)))
(command "_.CIRCLE" cmass (/ dx 70))
; m ; Radius of circle fixed
(setq delta (/ dx 50)) ; Size of cross fixed
(setq pt1 (list (- xcg delta) ycg)) ; The following lines draw
(setq pt2 (list (+ xcg delta) ycg)) ; a cross on the center
(command "_.LINE" pt1 pt2 "") ; of mass/area/neutral axis
(setq pt1 (list xcg (- ycg delta)))
(setq pt2 (list xcg (+ ycg delta)))
(command "_.LINE" pt1 pt2 "")
(redraw)
(textscr)
(prompt (strcat "Ağırlık Merkezi(x,y)= " cmass " Alan= " (rtos eai 2 2)))
(write-line "")
(prompt (strcat "Ixx (x-nötral eksen)= " (rtos inax 2 3) " Iyy (y-nötral eksen)= "
(rtos inay 2 3)
)
)
(write-line "") ; Write results on screen
(prompt (strcat "Ixx (x-global eksen)= " (rtos ixx 2 3) " Iyy (y-global eksen)= "
(rtos iyy 2 3)
)
)
(write-line "") ; Write results on screen
(setvar "MENUECHO" mecho) ; Set former values again
(setvar "CMDECHO" cecho)
(princ) ; Clean finish
) ; progn
)
; defun C:2DCM
