---

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

---

Morgen,
wo soll sich denn der Kreis am Ende befinden?
(noch im Block oder außerhalb)
... mit vla-copy kann man da hin und her kopieren ...
mfg heiko

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Eigentlich nur ersetzen, d.h. der Kreis sollte im Block bleiben !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

... "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

---

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

---

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

---

(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

---

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

---

vllt. hat CADmium oder wer anders einen Verbesserungsvorschlag... 
mfg Heiko

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

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

---

@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

---

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

---

...
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