| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Vom Bogen zu Kreis (1084 mal gelesen)
|
Ralf-CAD-Support Mitglied Techniker
Beiträge: 47 Registriert: 09.03.2007 PrDSU/FDSU 2016 und PSP 2011, Vault Prof. 2016
|
erstellt am: 09. Jul. 2008 18:05 <-- editieren / zitieren --> Unities abgeben:
Hallo, vielleicht hat/hatte ja jemand die gleich Anforderung ! Der Dreizeiler ersetzt einen Bogen durch einen Kreis. Leider werden die Elemente aus Blöcken nicht berücksichtigt. Kann zwar mit nentsel die Objekte erkennen, jedoch müsste dazu auch der Block bzw. die Pos des Blockes erkannt werden. Wenn also jemand eine Lösung hat, gerne ! vg Grüsse (defun c:b2k (/ bogen mit rad lay) (acet-error-init (list nil T)) ;acet-error-init (setq e (entsel "\nBitte Bogen auswählen: ")) (setq typ (cdr (assoc 0 (entget (car e))))) (if (= typ "ARC") (progn (setq bogen (entget (car e)) mit (cdr (assoc 10 bogen)) rad (cdr (assoc 40 bogen)) lay (cdr (assoc 8 bogen)) ) (entdel (car e)) (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") (cons 8 lay) '(100 . "AcDbCircle") (cons 10 mit) (cons 40 rad) '(210 0.0 0.0 1.0) ) ) ) (alert (strcat "Kein Bogen ausgewählt !")) ) (acet-error-restore) )
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 09. Jul. 2008 18:32 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
|
Ralf-CAD-Support Mitglied Techniker
Beiträge: 47 Registriert: 09.03.2007 PrDSU/FDSU 2016 und PSP 2011, Vault Prof. 2016
|
erstellt am: 09. Jul. 2008 18:35 <-- editieren / zitieren --> Unities abgeben:
|
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 09. Jul. 2008 19:02 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
... "eigentlich nur"... vllt so (vlax-invoke space 'AddCircle pt rad) space --> der Block pt --> Punkt im Block vom Bogen rad --> Radius vom Bogen mit nentsel solltes die Daten bekommen vla-put-layer ... im Nachgang die Eigenschaften (sonst IMHO vom aktuellen Layer) vla-delete arc nicht vergessen und einmal regen ... mfg heiko "so...object.AddCircle(Center, Radius) is the vba function call... to convert to vla function call: Step one. strcat vla- to front of method name eg: (vla-AddCircle Step two. pass object of method as first argument eg: (vla-AddCircle obj ... in this case, either model space block, paper space block or block definition block Step three. pass remaining arguments from the vba function to vla function as remaining parameters eg: (vla-AddCircle obj center radius) Step four: if a return val is listed for the method, set as req'd eg: (setq vobjCirc (vla-AddCircle obj center radius))"
[Diese Nachricht wurde von Dorfy am 09. Jul. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 10. Jul. 2008 08:36 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
Morgen, na dann mal was zum Frühstück... (defun C:b2k (/ vobj cen rad blk vobjCirc) (setq vobj (vlax-ename->vla-object (car (nentsel "Bogen: "))) cen (vlax-get vobj "Center") rad (vlax-get vobj "Radius") blk (vla-objectidtoobject (vla-get-document vobj) (vla-get-ownerid vobj) ) vobjCirc (vla-AddCircle blk (vlax-3d-point cen) rad) ) (vla-Delete vobj) (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports ) ) mfg heiko Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ralf-CAD-Support Mitglied Techniker
Beiträge: 47 Registriert: 09.03.2007 PrDSU/FDSU 2016 und PSP 2011, Vault Prof. 2016
|
erstellt am: 10. Jul. 2008 09:53 <-- editieren / zitieren --> Unities abgeben:
Na, für einen unwissenden schwere Kost am frühen Morgen Super, vielen Dank, Grund genug um mich einzulesen. Bei mir hat jetzt noch der (vl-load-com) Aufruf gefehlt Und die Layereigenschaften werden nicht abgefragt, ist aber eine gute Übung. Stelle den Text dan rein, sobald es funkt ! Nochmals - Danke ! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 10. Jul. 2008 10:20 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
(vl-load-com) lade ich in der acad.lsp immer mit... ... die Layereigenschaften werden nicht abgefragt ... IMHO ist es dann der aktuelle layer... mit vla-put kannst "vobjCirc"--> den Kreis die gewünschten Eigenschaften verpassen (siehe Hilfe oder Forum...) ... ist aber eine gute Übung. ... nentsel könnte man noch abfangen (...vl-catch...) ... die Update-Funktion ist auch noch net so schön (IMHO nur für Blöcke nötig) Edit: Vllt so... (defun C:b2k (/ ent vobj cen rad blk blkname aws vobjCirc) (while (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq ent (nentselp "Bogen: "))) ) ) ) (if (and ent (= "ARC" (cdr (assoc 0 (entget (car ent)))))) (and (setq vobj (vlax-ename->vla-object (car ent)) cen (vlax-get vobj "Center") rad (vlax-get vobj "Radius") blk (vla-objectidtoobject (vla-get-document vobj) (vla-get-ownerid vobj) ) vobjCirc (vla-AddCircle blk (vlax-3d-point cen) rad) ) (vla-Delete vobj) ) ) (if (not (wcmatch (setq blkname (vla-get-name blk)) "`*Model_Space,`*Paper_Space" ) ) (progn (if (setq AWS (ssget "X" (list '(0 . "INSERT") (cons 2 blkname)))) (progn (setq i 0) (repeat (sslength AWS) (setq ELE (ssname AWS i)) (entupd ele) (setq i (1+ i)) ) ) ) ) ) )
[Diese Nachricht wurde von Dorfy am 10. Jul. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ralf-CAD-Support Mitglied Techniker
Beiträge: 47 Registriert: 09.03.2007 PrDSU/FDSU 2016 und PSP 2011, Vault Prof. 2016
|
erstellt am: 10. Jul. 2008 15:08 <-- editieren / zitieren --> Unities abgeben:
Super - schnell, habe nur noch eingefügt: lay (vla-get-Layer vobj) vobjCirc (vla-AddCircle blk (vlax-3d-point cen) rad) ) (vla-put-Layer vobjCirc lay) (vla-Delete vobj) und (if (/= blk nil) (if (not (wcmatch ... Hoffe die Routine damit nicht abzuwerten und sie nicht nur von mir benötigt wird ! Wenn schon Dorfy "mal kurz" die Zeilen herzaubert ! Danke nochmals
[Diese Nachricht wurde von Ralf-CAD-Support am 10. Jul. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 10. Jul. 2008 16:07 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
|
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13508 Registriert: 30.11.2003 .
|
erstellt am: 10. Jul. 2008 16:23 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
ach .. da hab ihr euch jetzt soo gequält ... .. und irgendwie läufts ja scheinbar auch und macht glücklich. Deshalb halte ich mich mal zurück , möchte den Code aber trotzdem nicht als Schulungsunterlage empfehlen
------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 11. Jul. 2008 06:55 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
@CADmium ...nicht gleich gequält... ... aber Danke! @Ralf-CAD-Support ...hast du dir Linientyp und Stärke, Farbe etc. mal angeschaut ... (if (/= blk nil) --> (if blk ... also vllt so (if (and blk (not(wcmatch man könnt noch diverse Variablen sparen (vla-put-Layer vobjCirc (vla-get-Layer vobj)) analog cen rad mfg Heiko [Diese Nachricht wurde von Dorfy am 11. Jul. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ralf-CAD-Support Mitglied Techniker
Beiträge: 47 Registriert: 09.03.2007 PrDSU/FDSU 2016 und PSP 2011, Vault Prof. 2016
|
erstellt am: 14. Jul. 2008 12:16 <-- editieren / zitieren --> Unities abgeben:
Hi, derzeit werden die aktuellen Layereigenschaften verwendet. Nicht unbedingt die vornehme Art, wobei unsere Anwender gehalten sind am Standard (vonLayer) zu bleiben. Die Routine soll aber auch anderen dienen, daher wäre zumindest ein Hinweis sinnvoll. Brauche aber noch Zeit um mich da rein zu lesen, wie die jeweiligen Layereigenschaften gegenüber der Objekteigenschaften (vom Bogen) verglichen werden können ! Grüsse und eine gute Woche ! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dorfy Mitglied Double-Dipl.-Ing. Bleistiftanspitzer
Beiträge: 900 Registriert: 21.07.2006 AutoCad2007, ProE, HiCad
|
erstellt am: 14. Jul. 2008 13:13 <-- editieren / zitieren --> Unities abgeben: Nur für Ralf-CAD-Support
... lt, color ... eingebaut ;;Bogen zu Kreis (auch im Block) (defun C:b2k (/ ent vobj blk blkname aws vobjCirc) (while (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq ent (nentselp "Bogen: "))) ) ) ) (if (and ent (= "ARC" (cdr (assoc 0 (entget (car ent)))))) (progn (setq vobj (vlax-ename->vla-object (car ent)) blk (vla-objectidtoobject (vla-get-document vobj) (vla-get-ownerid vobj) ) vobjCirc (vla-AddCircle blk (vlax-3d-point (vlax-get vobj "Center")) (vlax-get vobj "Radius") ) ) (vla-put-Layer vobjCirc (vla-get-Layer vobj)) (vla-put-linetype vobjCirc (vla-get-linetype vobj)) (vla-put-color vobjCirc (vla-get-color vobj)) (vla-put-lineweight vobjCirc (vla-get-lineweight vobj)) (vla-Delete vobj) ) (princ "\n Das ist doch kein Bogen!?!") ) (if (and blk (not (wcmatch (setq blkname (vla-get-name blk)) "`*Model_Space,`*Paper_Space" ) ) ) (progn (if (setq AWS (ssget "X" (list '(0 . "INSERT") (cons 2 blkname)))) (progn (setq i 0) (repeat (sslength AWS) (entupd (ssname AWS i)) (setq i (1+ i)) ) ) ) ) ) ) mfg heiko Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |