Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Rund um AutoCAD
  Kreuzung von zwei Linien zu Bogen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Kreuzung von zwei Linien zu Bogen (446 mal gelesen)
xem
Mitglied
Zeichner


Sehen Sie sich das Profil von xem an!   Senden Sie eine Private Message an xem  Schreiben Sie einen Gästebucheintrag für xem

Beiträge: 847
Registriert: 07.08.2008

Software:
AutoCAD 2022 - 64bit
Windows 10 Pro - 64bit
PDFCreator 1.0.2 - 32bit
Ghostscript 9.0 - 64bit
PDF-XChange Viewer - 64bit
GIMP 2.6.8 - 64bit
MS Office 2013 - 32bit
Opera 12 - 32bit
MacroX - 32bit
7-zip - 64bit
-----------------------
Hardware:
Intel i5 680 3,6GHz @ 4GHz
8GB RAM 1333MHz
nVidia GTX 460 1024MB
Intel SSD 2.5 80GB X25-M
Samsung SyncMaster 245B+
Iiyama ProLite E1900s
Logitech mx518
Logitech G11
Roccat Sense Glacier Blue

erstellt am: 31. Mai. 2022 08:54    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


lbta.JPG

 
Hallo,

hat AutoCAD eine Funktion um aus einer Kreuzung von zwei Linien einen Bogen zu erstellen (siehe Anhang)?
Ich hatte schon mal vor längerer Zeit danach gesucht und ich glaube auch mal ein Lisp dazu gefunden. Habe aber nichts dazu gesichert.

Danke

Edit: gefunden 

Code:
(defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL O W)

(or(setq bDis(getreal "\nAbstand \"Radius\" <1.00> :"  ))
  (setq bDis 1.00)
)

(defun *error* (msg)
  (and uFlag (vla-EndUndoMark doc))
  (and ov  (mapcar (function setvar) vl ov))
  (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
  (princ))

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
      vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
(setvar "PEDITACCEPT" 1)

(while (and (setq uFlag (not (vla-StartUndoMark doc)))
            (mapcar  (function setvar) (cdr vl) '(0 32))
            (setq p1  (getpoint "\nPick INTERSECTION: "))
            (setq ent (entsel "\nPick LINE TO BREAK: ")))

  (setq p2 (osnap (cadr ent) "_nea")
        b1 (polar p1 (setq a (angle p1 p2)) bDis)
        b2 (polar p1 (+ pi a) bDis))

  (setvar "OSMODE" 0)
  (command "_.break" b1 b2)
  (setq bEnt (entlast))
  (if (> a (/ pi 2.))
    (command "_.arc" b2 "_E" b1 "_A" 180.)
    (command "_.arc" b1 "_E" b2 "_A" 180.))
  (setq aEnt (entlast))

  (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
    (progn
      (setq w (vla-get-ConstantWidth (setq o (vlax-ename->vla-object ent))))
      (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")
      (vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) w)))

  (setq uFlag (vla-EndUndoMark doc)))

(*error* nil) 
(princ))


[Diese Nachricht wurde von xem am 31. Mai. 2022 editiert.]

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

whf_muc
Mitglied
Techniker


Sehen Sie sich das Profil von whf_muc an!   Senden Sie eine Private Message an whf_muc  Schreiben Sie einen Gästebucheintrag für whf_muc

Beiträge: 270
Registriert: 22.05.2004

Fujitsu Celsius M770, Xeon 2125, 4,0 GHz, 32 GB RAM, Quadro P2000, Windoof 10 Pro for Workstations - div. liNear Haustechnik Aufsätze -
Autocad 2022/2023

erstellt am: 31. Mai. 2022 12:45    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für xem 10 Unities + Antwort hilfreich

Servus
dazu gabs mal ne fertige Lisp
Da ich nicht sicher bin, obs Freeware ist, hier auszugsweise :
Kreuzungen.lsp

KREUZUNGSPUNKTE - Einfügen eines Bogens an sich kreuzenden Linien

;;;Holger Brischke
;;;(defun - Lisp over night!
;;;Geisberg 84
;;;D-66132 Saarbrücken
;;;+49(0)681/989 06 84
;;;+49(0)175/205 88 77
;;;kontakt@defun.de
;;;http://www.defun.de
;;;

Viel Erfolg, Gruß Torsten

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

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2022
Bricscad V11-V21 pro
Plateia, Canalis
Visual Basic

erstellt am: 31. Mai. 2022 13:17    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für xem 10 Unities + Antwort hilfreich

Hallo,
Du mußt doch nur Deine Lisp um die Linie ergänzen:

Zitat:
Original erstellt von xem:

Code:
(defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL O W)

(or(setq bDis(getreal "\nAbstand \"Radius\" <1.00> :"   ))
   (setq bDis 1.00)
)

(defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov  (mapcar (function setvar) vl ov))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
(setvar "PEDITACCEPT" 1)

(while (and (setq uFlag (not (vla-StartUndoMark doc)))
             (mapcar   (function setvar) (cdr vl) '(0 32))
             (setq p1  (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))

   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (setq bEnt (entlast))
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))
   (setq aEnt (entlast))

   (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
     (progn
       (setq w (vla-get-ConstantWidth (setq o (vlax-ename->vla-object ent))))
       (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")
       (vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) w)))

   (if (eq "LINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
     (progn
       (setq w (vla-get-ConstantWidth (setq o (vlax-ename->vla-object ent))))
       (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")
       (vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) w)))

   (setq uFlag (vla-EndUndoMark doc)))

(*error* nil) 
(princ))




Grüße
Klaus  

[Diese Nachricht wurde von KlaK am 08. Jun. 2022 editiert.]

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz