Copyright © 2004-2022 SQL: 0.83 saniye - Sorgu: 46 - Ortalama: 0.01804 saniye
 |
 |
 |
 |
|
|
|
|
27.12.2021 06:48
aliigurer 
|
|
Herkese merhabalar.
Benim elimde bir çok arc çizgisi var ve bunların üstüne radius yazmam gerekiyor hepsinin radiusu farklı olduğundan dolayı biraz zaman alıyor arc çizgilerin başına ve sonuna circle'ları lisp ile yaptırdım ama yazıyı yazdıracak bir şey bulamadım yardımcı olabilirseniz gerçekten çok sevinirim. Şimdiden teşekküreler. İyi çalışmalar...
|
 ProhibiT
|
|
Soruluş şekline göre, "yazdırmak" dendiğine göre, Radius değeri Text olarak yazdırılmak isteniyor... diye anlaşılıyor. Sorular böyle sorulunca fehmetmek zorunda kalıyoruz.
Kod: (defun c:ArcR (/) (vl-load-com) (setq ocmd (getvar "cmdecho")) (setvar "cmdecho" 0) (defun *error* (er) (if (member er '("Function cancelled" "quit / exit abort")) (princ (strcat "\n*Error* " er))) (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e")) (if ocmd (setvar "cmdecho" ocmd)) (prin1)) (command "_.undo" "group") (while (setq Arcs (ssget (list (cons 0 "ARC")))) (setq n -1) (while (setq PvAr (ssname Arcs (setq n (1+ n)))) (setq PvId (vlax-ename->vla-object PvAr) PvRd (vlax-get-property PvId 'Radius) PvL2 (/ (vlax-get-property PvId 'ArcLength) 2.0) RtIp (vlax-curve-getPointAtParam PvId (vlax-curve-getParamAtDist PvId PvL2)) PTrv (vlax-curve-getFirstDeriv PvId (vlax-curve-getParamAtDist PvId PvL2)) RtRa (atan (/ (cadr PTrv) (car PTrv)))) (if (and (> RtRa (/ pi 2)) (<= RtRa (* 1.5 pi))) (setq RtRa (+ RtRa pi))) (if (> RtRa (* 2 pi)) (setq RtRa (- RtRa pi))) (entmake (list (cons 0 "TEXT") (cons 10 RtIp) (cons 7 (getvar "TextStyle")) (cons 40 (getvar "TextSize")) (cons 1 (rtos PvRd 2 (getvar "Luprec"))) (cons 50 RtRa) (cons 72 1) (cons 11 RtIp))))) (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e")) (if ocmd (setvar "cmdecho" ocmd)) (prin1)) Yazı yüksekliği, Text Style Layer, Color ve bunun gibi özellikler o an geçerli olan değerlerden alınır. Radius yazısının yeri için Arc'ın orta noktası, Yazı açısı da Arc'ın orta noktasındaki birinci türevi (bir fonksiyonun türevi, ilgili noktadaki teğetinin eğimi, yani tanjantıdır) Türevi alınarak elde edilen açı, teknik resim kurallarına göre (yazı paftanın sağ alt köşeden okunabilecek şekilde) düzenlenerek kullanıldı. Soruda açık olarak yazılmasa da, Angular-Radius Dimension olarak yazılırsa, daha esnek ve kullanışlı sonuç elde edilebilir, diye düşünmeden edemedim. Kod: (defun c:ArcR (/) (vl-load-com) (setq ocmd (getvar "cmdecho")) (setvar "cmdecho" 0) (defun *error* (er) (if (member er '("Function cancelled" "quit / exit abort")) (princ (strcat "\n*Error* " er))) (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e")) (if ocmd (setvar "cmdecho" ocmd)) (prin1)) (command "_.undo" "group") (while (setq Arcs (ssget (list (cons 0 "ARC")))) (setq n -1) (while (setq PvAr (ssname Arcs (setq n (1+ n)))) (setq PvId (vlax-ename->vla-object PvAr) PvRd (vlax-get-property PvId 'Radius) PvAc (vlax-safearray->list (vlax-variant-value (vlax-get-Property PvId 'Center))) PvAo (vlax-curve-getPointAtParam PvId (vlax-curve-getParamAtDist PvId (/ (vlax-get-property PvId 'ArcLength) 2.0))) DtIp (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) PvAc PvAo)) (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 PvAc) (cons 11 DtIp) '(70 . 164) '(1 . "") '(71 . 5) '(100 . "AcDbRadialDimension") (cons 15 PvAo))))) (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e")) (if ocmd (setvar "cmdecho" ocmd)) (prin1)) Fonksionun bu ikinci halinde de o an geçerli olan dimension style kullanıldı. turgay girgin arkadaşımızın sorduğu variant ve safearray kavramları burada kullanılmış olmakla birlikte... söz verdiğim gibi detaylı açıklamaları ayrıca paylaşılacaktır. Kolay gelsin.
|