---

Hallo,

es sollen auf eine Zeichnung alle Konturen (Polylinien oder LW-Polylinien) "automatisch" nach innen versetzt werden. Es sind meistens Rechtecke oder Kreise.
Die Konturen liegen auf einem bestimmten Layer z.b. "kontur_innen", damit kann bestimmt werden welche Elemente in Frage kommen. Der Versetz-Abstand ist für alle Elemente gleich.

Wer kennt ein Tool dafür oder ist bereit so ein Tool (nicht für umsonst)in Lisp zu programmieren.

Gruß
Theodor Schönwald

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

---

..immer geschlossende Kurven ?
..reicht nicht ein offset mit vorheriger Bestimmung was innen ist?

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

---

Servus Theodor

Könnt mich am WE daran versuchen - falls sich nicht vorher jemand findet.

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Thomas,

doch das würde reichen, aber wie: "... Bestimmung was innen ist?"
Bei einem Kreis ganz einfach, wie aber bei anderen Konturen?
Es sind immer geschlossene Polylinien oder Kreise.

Gruß
Theodor

[Diese Nachricht wurde von Theodor Schoenwald am 12. Aug. 2008 editiert.]

[Diese Nachricht wurde von Theodor Schoenwald am 12. Aug. 2008 editiert.]

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

---

Hallo Ernst,

auf jeden Fall würde ich mich auf einen Vorschlag (Lösung) von Dir freuen.

Gruß
Theodor

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

---

Hallo !

Wenn Vla-Funktionen "zulässig" sind, dann ist das mittels vla-offset einfach möglich.
Bei Fragen....

Grüße
Andi

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

---

Hab mal schnell was zusammenkopiert...
Die gewählte Pline wird dabei immer um 2ZE nach innen versetzt.

Code:

---

(defun c:test (/ ename)
  (if (= "CW" (getdir-pline (setq ename (car (entsel "\nPline wählen:")))))
    (vla-offset (vlax-ename->vla-object ename) 2.0)
    (vla-offset (vlax-ename->vla-object ename) -2.0)
  )
  (princ)
)

(defun getdir-pline (ename /)
  (if (minusp (seglist-area (obj2seglist (vlax-ename->vla-object ename))))
    "CW"
    "CCW"
  )
)
(defun seglist-area (seglist /)
  (* 0.5
    (apply '+
    (mapcar '(lambda (seg)
      (+ (if (zerop (caddr seg))
    0.0
    (* 2 (seg-area seg))
  )
  (* (- (caar seg) (caadr seg)) (+ (cadar seg) (cadadr seg)))
      )
    )
    seglist
    )
    )
  )
)
(defun seg2rad (seg /)
  (/ (* 0.5 (distance (car seg) (cadr seg)))
    (sin (* 0.5 (* 4 (atan (caddr seg)))))
  )
)
(defun seg-area (seg / alfa r)
  (setq alfa (* 4 (atan (caddr seg)))
r    (seg2rad seg)
  )
  (* (* 0.5 (* r r)) (- alfa (sin alfa)))
)
(defun obj2seglist (obj / endpara para seglist)
  (setq endpara (vlax-curve-getendparam obj)
para (vlax-curve-getstartparam obj)
  )
  (while (< para endpara)
    (setq seglist (cons (list (vlax-curve-getpointatparam obj para)
      (vlax-curve-getpointatparam obj (1+ para))
      (vla-getbulge obj para)
)
seglist
  )
  para   (1+ para)
    )
  )
  (reverse seglist)
)

---

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

---

Hallo Andy,

zuerst vielen Dank. Das Ergebnis:
in ACAD einwandfrei,
in ZWCAD auch einwandfrei,
in Bricscad leider nur eine Fehlermeldung.

Wie Du schon vermutet hast, sind es die VL Befehle.
Seit Torsten Moses bei Bricscad ist, funktionieren schon viele VL-Befehle aber es gibt damit immer noch Probleme.

Gruß
Theodor

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

---

Zitat:

---

Original erstellt von Theodor Schoenwald:
[i]Hallo Thomas,

doch das würde reichen, aber wie: "... Bestimmung was innen ist?"
Bei einem Kreis ganz einfach, wie aber bei anderen Konturen?
Es sind immer geschlossene Polylinien oder Kreise.

---

Es gibt zwei einfache Methoden, um für einen beliebigen Punkt festzustellen, ob er innerhalb oder außerhalb einer Kontur liegt. Beide Methoden funktionieren auch mit offenen Polylinien, wobei dann Anfangs- und Endpunkt als verbunden betrachtet werden. Beide Methoden können auch mit sich selbst schneidenden Polygonen umgehen.

1. Schnittpunkt-Methode: hier ziehst Du vom zu prüfenden Punkt einen Strahl ins Unendliche (also außerhalb der aktuellen Zeichnungsgrenzen) und zählst die Anzahl der Schnittpunkte des Strahls mit den Kanten des Polygons. Für einen Punkt innerhalb des Polygons ist die Anzahl größer Null und ungerade. Probleme gibt's, wenn zufälligerweise der Strahl genau auf einen Knoten des Polygons fällt.

2. Winkel-Methode: Du misst für jede Kante des Polygons den Winkel, den die beiden Linien vom zu prüfenden Punkt zu den Ecken bilden - gegen den Uhrzeigersinn laufende Winkel müssen als negative Winkel gerechnet werden. Bei einem Punkt innerhalb des Polygons ist die Winkelsumme ein ganzzahliges Vielfaches von 360 Grad.

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

---

Mein erster Gedanke war, die PLs in beide Richtungen zu versetzen - Umfang/Länge der beiden prüfen - die mit dem größeren Umfang/Länge wieder wegschmeissen. ??? (Hab aber jetzt Andis Code nur überflogen - könnte ähnlich sein ?)

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Servus Theodor

Teste mal - ich hoffe, es tut, was Du willst.

Code:

---

;Hauptprogramm - (LW)POLY's um #versatz nach innen versetzen
(defun c:niv (/ #versatz #aws #ename #2plist #spkt #p2 #vobj1 #vobj2 #lg1 #lg2)
  (setvar "OSMODE" 0)
  (setq #versatz 2.0)
  (setq #aws (f#sstolist (ssget "X" '((0 . "LWPOLYLINE,POLYLINE")(8 . "kontur_innen")))))
  (foreach #ename #aws
    (setq #2plist (f#pkte #ename))
    (setq #spkt
      (polar
        (setq #p2 (cadr #2plist))
        (+ (angle #p2 (car #2plist)) (/ pi 2))
        #versatz
      )
    )
    (command "_OFFSET" #versatz (list #ename #p2) #spkt "")
    (command "_AREA" "_O" (setq #vobj1 (entlast)))
    (setq #lg1 (getvar "PERIMETER"))
    (setq #spkt
      (polar
        (setq #p2 (cadr #2plist))
        (- (angle #p2 (car #2plist)) (/ pi 2))
        #versatz
      )
    )
    (command "_OFFSET" #versatz (list #ename #p2) #spkt "")
    (command "_AREA" "_Object" (setq #vobj2 (entlast)))
    (setq #lg2 (getvar "PERIMETER"))
    (cond
      ( (< #lg1 #lg2)
        (entdel #vobj2)
      )
      ( (> #lg1 #lg2)
        (entdel #vobj1)
      )
      ( (= #lg1 #lg2)
        (Alert "Kann innen und aussen nicht unterscheiden")
      )
    );cond
  );foreach
);defun

(defun f#sstolist (#sset / #list #counter)
  (setq #counter 0)
  (repeat (sslength #sset)
    (setq #list (cons (ssname #sset #counter) #list)
          #counter (1+ #counter)
    )
  )
  #list
);defun

(defun f#plist (#ename / #elist #pktlist)
  (setq #elist (entget #ename))
  (setq #pktlist nil)
  (while #elist
    (if (/= (caar #elist) 10)
      (setq #elist (cdr #elist))
      (progn
        (setq #pktlist (cons (cdar #elist) #pktlist))
        (setq #elist (cdr #elist))
      )
    )
  )
  (reverse #pktlist)
);defun

(defun f#pkte (#ename / )
  (if (= "LWPOLYLINE" (cdr (assoc 0 (entget #ename))))
    (list (car (f#plist #ename)) (cadr (f#plist #ename)))
    (list
      (cdr (assoc 10 (entget (entnext #ename))))
      (cdr (assoc 10 (entget (entnext (entnext #ename)))))
    )
  );if
);defun

---

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Ernst,

Dein Tool funktioniert bei ACAD und bei BricsCad.

Vielen Dank!

Viele Grüße
Theodor

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

---

Hallo Ernst,

funktioniert, doch nicht ganz.
Wenn eine Kontur im UZ-Sinn läuft ja, wenn im GUZ wird 2 x nach außen versetzt.

Beim Probieren habe ich auch ein Fehler von ACAD entdeckt.
Beispiel:
Viereck von 10,10 nach 120,120,
Versatz 2 mm
Acad-Befehl: "Versetz"
Abstand: 2
ACAD-Abfrage: Auf welche Seite soll versetzt werden?
Wenn ich als Punkt "8,120" eingebe, wird die Kontur nach innen versetzt, obwohl der Punkt "8,120" außerhalb liegt.
Den Test habe ich mit ACAD 2000 gemacht.
Da BricsCad eine Option hat nach beiden Seiten zu versetzen, wäre damit alles noch viel einfacher als bei ACAD.

Wenn ich die nächste Woche zurück bin, werde ich alles noch ausführlicher testen.

Gruß

Theodor

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

---

Objektfang aktiv ?

Grüße

Andi

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

---

Hi Andy
OSMODE ist schon auf 0.

Hallo Theodor

Zitat:

---

Beim Probieren habe ich auch ein Fehler von ACAD entdeckt.
Beispiel:
Viereck von 10,10 nach 120,120,
Versatz 2 mm
Acad-Befehl: "Versetz"
Abstand: 2
ACAD-Abfrage: Auf welche Seite soll versetzt werden?
Wenn ich als Punkt "8,120" eingebe, wird die Kontur nach innen versetzt, obwohl der Punkt "8,120" außerhalb liegt.

---

Das würde ich nicht unbedingt als Fehler sehen:
Mit dem Pickpunkt (bei der Objektwahl) und dem Punkt (8,120) gibst Du eine Richtung an und die zeigt erstmal nach innen, auch wenn Du auf dem Weg zum Punkt das Rechteck später wieder verlässt.
Allerdings - mit den Sonderfällen beim Versetzen werden wir leben müssen.

Der UZ ist bei mir (2002) egal - versetzt immer nach innen 
Müßte von der Logik auch egal sein:
stell dich auf den 2.Pkt der (LW-)Polylinie
orientiere dich auf den 1.Pkt
rechne einen Pkt nach rechts
versetze die Linie in diese Richtung
ermittle die Länge
rechne einen Pkt nach links
versetze die Linie in diese Richtung
ermittle die Länge
lösche die Linie mit der größeren Länge

Vielleicht kannst Du die DWG hier einstellen?

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Vers_test1.txt

Hallo Ernst,

im Anhang ist eine Musterzeichnung.
Der Fang war ausgeschaltet.
Unten 2 Rechtecke als Polylinie, ein UZ die andere GUZ.
Oben 2 x als LW-Polylinien eine UZ die andere GUZ.

Bei der unteren rechts wurde 2 x nach innen versetzt.
Da sind innen 2 Konturen.

Die Datei habe ich umbenannt als .TXT einfach wieder zu .DWG machen.

Gruß
Theodor

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

---

Servus Theodor

Kanns mir leider erst am Abend anschauen ...

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Theodor

Die Idee, den Seitpunkt einfach nach links und rechts (im rechten Winkel) zu rechnen, war nicht so gut. Ich hab leider nur mit Vielecken getestet. Im "Spezialfall Rechteck" fällt dann ein Punkt genau auf die Linie.

Wenn man aber beim Berechnen der Seitpunkte -

Code:

---

(setq #spkt
      (polar
        #p2
        ([+/-] (angle #p2 #p1) (/ pi 3))
        #versatz
      )
    )

---

anstelle von pi/2 pi/3 nimmt, sollte es bei Rechtecken und Kreisen funktionieren. Bei Konturen mit spitzen Winkeln (falls Du solche auch hast) wird das Programm aber nach wie vor scheitern.

Zitat:

---

Da BricsCad eine Option hat nach beiden Seiten zu versetzen...

---

Das könnte die Lösung sein, wenn Du dieses Prog. nur für Briscad nehmen willst und sonst das von Andi.
Müßtest mir aber die Syntax des Befehls liefern ?(command "_offset" ... )? - ich kenne Briscad nämlich nicht.

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Eine Möglichkeit wäre z.B den Offsetpunkt vom Mittelpunkt des ersten Plinesegments aus zu berechnen. (Achtung bei Bogensegmenten...)

Pline CW -> Mittelpunkt des Segments nach rechts
Pline CCW -> ... nach links

Die Pline einfach in beide Richtungen verstezen, und dann die längere weglöschen, kann auch in die Hose gehen, wenn beim Versetzen mehrere Offsetkonturen entstehen.

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

---

Hi Andi

Zitat:

---

...Offsetpunkt vom Mittelpunkt des ersten Plinesegments...

---

Hatte ich auch versucht, bin aber gleich bei der ersten "runden" PL gescheitert - Ausbuchtung war größer als #versatz.

Dass beim Versetzen mehrere neue Konturen entstehen können wusste ich bis jetzt nicht. Wann ist das der Fall?

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Ernst,

so geht es bei BricsCad:

_offset
Abstand:
Objekt wählen:
_b (oder b)
danach Return wie beim normalen Versetzbefehl auch.

Jetzt kann ich Dein Programm für BricCad verwenden und
für ACAD das von Andy.

Nochmals vielen Dank an euch Beide.

Gruß
Theodor Schönwald

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

---

Hallo Theodor

Das ist jetzt mit einigen "?" behaftet, da ichs ja nicht testen kann - das überlass' ich Dir. 

Code:

---

(defun c:niv (/ #versatz #letztes #aws #ename #p1 #vobj1 #vobj2 #lg1 #lg2)
  (setvar "OSMODE" 0)
  (setq #versatz 2.0)
  (setq #letztes (entlast))
  (if (setq #aws (ssget "X" '((0 . "LWPOLYLINE,POLYLINE")(8 . "kontur_innen"))))
    (progn
      (setq #aws (f#sstolist #aws))
      (foreach #ename #aws
        (if (= "LWPOLYLINE" (cdr (assoc 0 (entget #ename))))
          (setq #p1 (cdr (assoc 10 (entget #ename))))
          (setq #p1 (cdr (assoc 10 (entget (entnext #ename)))))
        )
        (command "_OFFSET" #versatz (list #ename #p1) "_B" "")
        (command "_AREA" "_O" (setq #vobj1 (entnext #letztes)))
        (setq #lg1 (getvar "PERIMETER"))
        (command "_AREA" "_O" (setq #vobj2 (entnext #vobj1)))
        (setq #lg2 (getvar "PERIMETER"))
        (cond
          ( (< #lg1 #lg2)
            (entdel #vobj2)
          )
          ( (> #lg1 #lg2)
            (entdel #vobj1)
          )
          ( (= #lg1 #lg2)
            (alert "Kann innen und aussen nicht unterscheiden")
          )
        )
      )
    )
    (alert "Keine Objekte entsprechen den Auswahlkriterien")
  )
)
(defun f#sstolist (#sset / #list #counter)
  (setq #counter 0)
  (repeat (sslength #sset)
    (setq #list (cons (ssname #sset #counter) #list)
          #counter (1+ #counter)
    )
  )
  #list
)

---

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Ernst,

der Versatz nach beiden Seiten funktioniert einwandfrei.
Danach komme ich nicht weiter, weil nach "_AREA" 2 x die gleiche Länge ausgegeben wird. Wenn ich den Elementen (entlast) eine andere Farbe gebe wird eines gefärbt. Je nach Konturrichtung einmal das äußere oder das innere Element Element gefärbt.

Gruß
Theodor

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

---

Ich glaube, ich kenn den Fehler:
das (entnext) einer Polyline/Insert/... ist ein Vertex/Attribut/ ...
und nicht das gesuchte nächste Hauptobjekt.

Über die Lösung muss ich aber noch nachdenken ... 

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Zitat:

---

Original erstellt von Geos:
Ich glaube, ich kenn den Fehler:
das (entnext) einer Polyline/Insert/... ist ein Vertex/Attribut/ ...
und nicht das gesuchte nächste Hauptobjekt.

Über die Lösung muss ich aber noch nachdenken ...  

---

sowas (ähnliches) ?

(while (and(setq OBJ(entnext OBJ))
          (setq DATA(entget OBJ))
          (/=(cdr(assoc 0 DATA)) "SEQUEND")
      )
)

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

---

Servus

Ich hätte vor dem Nachdenken nochmal hier reinschauen sollen ...
Thomas, in diese Richtung hab ich auch gedacht, war mir dann aber nicht sicher, ob alle dies "zusammengesetzten Objekte " mit SEQUEND enden. Aber nachdem Du es hier vorschlägst, geh ich mal davon aus (für die Zukunft ...) .

Hier sollte es reichen, wenn ich das garantiert letzte Objekt sichere - dann ist (entnext) die eine Kontur und (entlast) die andere - gibt ja nur 2 Neue (meines Wissens nach ...?)

Theodor, probier noch mal:

Code:

---

(defun c:niv (/ #versatz #letztes #aws #ename #p1 #vobj1 #vobj2 #lg1 #lg2)
  (setvar "OSMODE" 0)
  (setq #versatz 2.0)
  (setq #letztes (entlast))
  (while (entnext (entlast))
    (setq #letztes (entnext (entlast)))
  )
  (if (setq #aws (ssget "X" '((0 . "LWPOLYLINE,POLYLINE")(8 . "kontur_innen"))))
    (progn
      (setq #aws (f#sstolist #aws))
      (foreach #ename #aws
        (if (= "LWPOLYLINE" (cdr (assoc 0 (entget #ename))))
          (setq #p1 (cdr (assoc 10 (entget #ename))))
          (setq #p1 (cdr (assoc 10 (entget (entnext #ename)))))
        )
        (command "_OFFSET" #versatz (list #ename #p1) "_B" "")
        (command "_AREA" "_O" (setq #vobj1 (entnext #letztes)))
        (setq #lg1 (getvar "PERIMETER"))
        (command "_AREA" "_O" (setq #vobj2 (entlast)))
        (setq #lg2 (getvar "PERIMETER"))
        (cond
          ( (< #lg1 #lg2)
            (entdel #vobj2)
          )
          ( (> #lg1 #lg2)
            (entdel #vobj1)
          )
          ( (= #lg1 #lg2)
            (Alert "Kann innen und aussen nicht unterscheiden")
          )
        )
      )
    )
    (alert "Keine Objekte entsprechen den Auswahlkriterien")
  )
)
(defun f#sstolist (#sset / #list #counter)
  (setq #counter 0)
  (repeat (sslength #sset)
    (setq #list (cons (ssname #sset #counter) #list)
          #counter (1+ #counter)
    )
  )
  #list
)

---

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Ernst,

BricsCad kann das Tool nicht leiden und stürzt ab.

Wenn ich die folgenden Zeilen:
------------------------------------
(while (entnext (entlast))
  (setq #letztes (entnext (entlast)))
)
---------------------------------------
auskommentiere, dann stützt es nicht ab.

Dann wird bei einem Element die Kontur richtig versetzt, beim nächsten wird das innere gelöscht und bei anderen Konturen sind beide da und keines wird gelöscht, obwohl alles Rechtecke waren. Dann habe ich Kreise zu Polylinen gemacht, auch hierbei ist alles willenlos.

Um noch eines drauf zu setzen, wenn ich den Befehl wiederhole, werden auf der gleichen Zeichnung wieder andere Konturen richtig und falsch versetzt.
D.h versetzt werden sie alle auf beiden Seiten nur die falschen oder keine gelöscht.

Außer Deinen Vorschlägen habe ich auch selbst verschiedene Varianten probiert, ich kam zu keinem brauchbaren Ergebnis.

Gruß
Theodor

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

---

Hallo Ernst,

da BricsCad so ärgerlich abstürzt, dass der PC nur noch am Schalter an der Steckerleiste ausgeschaltet werden kann, habe ich nochmals mit Deiner ersten Version probiert.

;;Hauptprogramm - (LW)POLY's um #versatz nach innen versetzen
(defun C:NIV (/ #VERSATZ #AWS #ENAME #2PLIST #SPKT #P2 #VOBJ1 #VOBJ2 #LG1 #LG2)
(setvar "OSMODE" 0)
(setq #VERSATZ 2.0)
(setq #AWS (F#SSTOLIST (ssget "X" '((0 . "LWPOLYLINE,POLYLINE") (8 . "kontur_innen")))))
(foreach #ENAME #AWS
  (setq #2PLIST (F#PKTE #ENAME))
  (setq #SPKT
        (polar
        (setq #P2 (cadr #2PLIST))
        (+ (angle #P2 (car #2PLIST)) (/ pi 2))
        #VERSATZ
        )
  )
  (command "_OFFSET" #VERSATZ (list #ENAME #P2) #SPKT "")
  (command "_AREA" "_O" (setq #VOBJ1 (entlast)))
  (setq #LG1 (getvar "PERIMETER"))
  (setq #SPKT
        (polar
        (setq #P2 (cadr #2PLIST))
        (- (angle #P2 (car #2PLIST)) (/ pi 3))
        #VERSATZ
        )
  )
  (command "_OFFSET" #VERSATZ (list #ENAME #P2) #SPKT "")
  (command "_AREA" "_Object" (setq #VOBJ2 (entlast)))
  (setq #LG2 (getvar "PERIMETER"))
  (cond
  ((< #LG1 #LG2)
    (entdel #VOBJ2)
  )
  ((> #LG1 #LG2)
    (entdel #VOBJ1)
  )
  ((= #LG1 #LG2)
    (alert "Kann innen und aussen nicht unterscheiden")
  )
  ) ;_ cond
) ;_ foreach
) ;_ defun

(defun F#SSTOLIST (#SSET / #LIST #COUNTER)
(setq #COUNTER 0)
(repeat (sslength #SSET)
  (setq #LIST    (cons (ssname #SSET #COUNTER) #LIST)
        #COUNTER (1+ #COUNTER)
  )
)
#LIST
) ;_ defun

(defun F#PLIST (#ENAME / #ELIST #PKTLIST)
(setq #ELIST (entget #ENAME))
(setq #PKTLIST NIL)
(while #ELIST
  (if (/= (caar #ELIST) 10)
  (setq #ELIST (cdr #ELIST))
  (progn
    (setq #PKTLIST (cons (cdar #ELIST) #PKTLIST))
    (setq #ELIST (cdr #ELIST))
  )
  )
)
(reverse #PKTLIST)
) ;_defun

(defun F#PKTE (#ENAME /)
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget #ENAME))))
  (list (car (F#PLIST #ENAME)) (cadr (F#PLIST #ENAME)))
  (list
  (cdr (assoc 10 (entget (entnext #ENAME))))
  (cdr (assoc 10 (entget (entnext (entnext #ENAME)))))
  )
) ;_ if
) ;_defun
(princ)

Wenn ich "(- (angle #P2 (car #2PLIST)) (/ pi 3))" ändere, funktioniert es bei Polylinien aus Kreisen und bei Rechtecken, bei spitzen Konturen nicht.

Wenigstens so viel.

Gruß
Theodor

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

---

Hab das Thema nicht genau verfolgt, aber so wie ich es sehe hakt es beim Berechnen des Offsetpunktes.

Habe meinen ersten Code von VLA-Funktionen befreit - Back to the roots 
Der Offsetpunkt wird am tatsächlichen Mittelpunkt des 1. Plinesegments senkrecht zur Kontur berechnet. Ich habe hierfür einen sehr geringen Abstand (0.001) gewählt. Die Offsetrichtung bestimme ich wieder in Abhängigkeit der Laufrichtung.

Es wird aber nur eine Pline versetzt. Das Gebrösel mit dem Auswahlsatz für alle Pline's war mir jetzt zu blöd.
Dürfte für Dich eigentlich kein Problem sein das noch einzubauen !

Code:

---

(defun c:test (/ ename midpt1st p1 p2 seglist offsetpt)
  (setq ename    (car (entsel "\nPline wählen:"))
        ;; Pline -> Segmentliste
        seglist  (dxf2seglist (entget ename))
        ;; Mittelpunkt von 1. Segment
        midpt1st (getmid-seg (car seglist))
        ;; 1. Vertex
        p1      (caar seglist)
        ;; 2.Vertex
        p2      (cadar seglist)
  )
  ;; Offsetpunkt in Abhängigkeit der Laufrichtung bestimmen
  ;; der Offsetpunkt wird in einem Abstand von 0.001 vom Mittelpunkt des 1. Plinesegments berechnet
  (setq offsetpt (polar midpt1st
                        (+ (angle p1 p2)
                          (if (minusp (seglist-area seglist))
                            ;; "CW" -> Offset nach rechts
                            (* -0.5 pi)
                            ;; "CCW" -> Offset nach links
                            (* 0.5 pi)
                          )
                        )
                        0.001
                )
  )
  ;; Offset
  (command "_OFFSET" 2.0 ename "_non" offsetpt "")
  ;; nur zum Testen Offsetpunkt einzeichnen
  (setvar "PDmode" 2)
  (setvar "PDsize" 2)
  (command "_POINT" "_non" offsetpt)
  (princ)
)
;;;---------------------------------------
;;; Fläche von SegList (Pline) berechnen
;;; wenn Fläche negativ, dann ist die Laufrichtung "CW"
;;;            positiv                            "CCW"
;;;---------------------------------------
(defun seglist-area (seglist /)
  (* 0.5
    (apply '+
            (mapcar '(lambda (seg)
                      (+ (if (zerop (caddr seg))
                            0.0
                            (* 2 (seg-area seg))
                          )
                          (* (- (caar seg) (caadr seg)) (+ (cadar seg) (cadadr seg)))
                      )
                    )
                    seglist
            )
    )
  )
)
(defun seg2rad (seg /)
  (/ (* 0.5 (distance (car seg) (cadr seg)))
    (sin (* 0.5 (* 4 (atan (caddr seg)))))
  )
)
(defun seg-area (seg / alfa r)
  (setq alfa (* 4 (atan (caddr seg)))
        r    (seg2rad seg)
  )
  (* (* 0.5 (* r r)) (- alfa (sin alfa)))
)

;;;----------------------------------
;;; Mittelpunkt von Segment berechnen
;;;----------------------------------
(defun getmid-seg (seg / sp ep bulge cir cen rad)
  (setq sp    (car seg)
        ep    (cadr seg)
        bulge (caddr seg)
  )
  (if (zerop bulge)
    ;; Line -> direkter Mittelpunkt
    (mapcar (function (lambda (c1 c2) (+ c1 (/ (- c2 c1) 2.0)))) sp ep)
    ;; ARC -> Mittelpunkt auf Bogen berechnen
    (progn (setq cir (seg2cir seg)
                cen (car cir)
                rad (cadr cir)
          )
          (polar cen
                  (+ (angle sp ep)
                    (if (minusp bulge)
                      (/ pi 2.0)
                      (/ pi -2.0)
                    )
                  )
                  rad
          )
    )
  )
)
;;;------------------------------------------------------------
;;; Konvertiert ein gekrümmtes Polyliniensegment (pt1 pt2 bulge)
;;; in -> (Zentrum Radius)
;;; Gibt NIL bei gerader Linie zurück.
;;;------------------------------------------------------------
(defun seg2cir (seg / bulge p1 p2 cot x y rad dummy)
  (if (zerop (caddr seg))
    nil
    (setq p1    (car seg)
          p2    (cadr seg)
          bulge (caddr seg)
          cot  (* 0.5 (- (/ 1.0 bulge) bulge))
          x    (/ (- (+ (car p1) (car p2)) (* (- (cadr p2) (cadr p1)) cot)) 2.0)
          y    (/ (+ (+ (cadr p1) (cadr p2)) (* (- (car p2) (car p1)) cot)) 2.0)
          rad  (distance (list (car p1) (cadr p1)) (list x y))
          dummy (list (list x y) rad)
    )
  )
)

;;;------------------------------------------------------------
;;; Segmentliste bilden ((P1 P2 Bulge1) (P2 P3 Bulge2)....)
;;;------------------------------------------------------------
(defun dxf2seglist (dxflist / p1 tmpename tmpdxflist ptlist bulgelist)
  (setq p1 (cdr (assoc 10 dxflist)))
  ;; GC 10 + 42 extrahieren
  (if (= "LWPOLYLINE" (cdr (assoc 0 dxflist)))
    ;; LWPOLYLINE
    (foreach item dxflist
      (cond ((= 10 (car item)) (setq ptlist (cons (cdr item) ptlist)))
            ((= 42 (car item)) (setq bulgelist (cons (cdr item) bulgelist)))
      )
    )
    ;; POLYLINE
    (progn (setq tmpename (entnext (cdr (assoc -1 dxflist)))
                p1      (cdr (assoc 10 (entget tmpename)))
          )
          (while (= "VERTEX" (cdr (assoc 0 (setq tmpdxflist (entget tmpename)))))
            (setq ptlist    (cons (cdr (assoc 10 tmpdxflist)) ptlist)
                  bulgelist (cons (cdr (assoc 42 tmpdxflist)) bulgelist)
                  tmpename  (entnext tmpename)
            )
          )
    )
  )
  (if (not (zerop (logand 1 (cdr (assoc 70 dxflist)))))
    ;; Pline geschlossen -> ersten Punkt zum Schluß nochmal anfügen
    (setq ptlist (cons p1 ptlist))
  )
  ;; Rückgabe
  (mapcar 'list (reverse ptlist) (cdr (reverse ptlist)) (reverse bulgelist))
)

---

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

---

Hallo Theo

Is etwas schwierig für mich -

Code:

---

(while (entnext (entlast))
  (setq #letztes (entnext (entlast)))
)

---

ist eigentlich gar nix besonderes.
Wenn BricsCad das nicht mag, wird - wenn das letzte Objekt vor dem Versetzen zB. eine (Heavy-)Polyline war - diese mit der 2. Kontur verglichen, was zu einen falschen Ergebnis führt.

Aber Dank Andi stellt sich das Problem ja nicht mehr ...

Zum Verheiraten der beiden Progs:

Nimm von mir:

Code:

---

(setq #aws (f#sstolist (ssget "X" '((0 . "LWPOLYLINE,POLYLINE")(8 . "kontur_innen")))))
(foreach ename #aws
  (andisprog ename)  ;neu
)

---

und ändere Andi's erste Zeile:

Code:

---

(defun c:test (/ ename midpt1st p1 p2 seglist offsetpt)

---

zu

Code:

---

(defun andisprog (ename / midpt1st p1 p2 seglist offsetpt)

---

die 2.Zeile

Code:

---

(setq ename (car (entsel "\nPline wählen:"))

---

weglassen

Kommst Du damit klar?

------------------
Schöne Grüße
Ernst

www.geopaint.at

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

---

Hallo Andy, hallo Ernst,

jetzt läuft alles einwandfrei.
In ACAD hatte es vorher schon funktioniert, nun läuft es auch in BricsCad einwandfrei.
Das Gebrösel mit der Auswahl ist auch gemacht.

Vielen Dank an Euch Beide

Theodor

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

---

Hallo Andi,

vielleicht könnte mir da jemand behilflich sein (Bin mit LISP nicht sooo Fit, aber ich übe noch ;-))
Für meine Zwecke wäre es hilfreich das das Quellobjekt in der LISP von andi2050 gelöscht wird?!
Wie stelle ich das an?

THX
Jörg

Zitat:

---

Original erstellt von andi2050:
Hab mal schnell was zusammenkopiert...
Die gewählte Pline wird dabei immer um 2ZE nach innen versetzt.

<BLOCKQUOTE><font size="2" face="Courier New">Code:<HR>
(defun c:test (/ ename)
  (if (= "CW" (getdir-pline (setq ename (car (entsel "\nPline wählen:")))))
    (vla-offset (vlax-ename->vla-object ename) 2.0)
    (vla-offset (vlax-ename->vla-object ename) -2.0)
  )
  (princ)
)

(defun getdir-pline (ename /)
  (if (minusp (seglist-area (obj2seglist (vlax-ename->vla-object ename))))
    "CW"
    "CCW"
  )
)
(defun seglist-area (seglist /)
  (* 0.5
     (apply '+
    (mapcar '(lambda (seg)
       (+ (if (zerop (caddr seg))
    0.0
    (* 2 (seg-area seg))
  )
  (* (- (caar seg) (caadr seg)) (+ (cadar seg) (cadadr seg)))
       )
     )
    seglist
    )
     )
  )
)
(defun seg2rad (seg /)
  (/ (* 0.5 (distance (car seg) (cadr seg)))
     (sin (* 0.5 (* 4 (atan (caddr seg)))))
  )
)
(defun seg-area (seg / alfa r)
  (setq alfa (* 4 (atan (caddr seg)))
r    (seg2rad seg)
  )
  (* (* 0.5 (* r r)) (- alfa (sin alfa)))
)
(defun obj2seglist (obj / endpara para seglist)
  (setq endpara (vlax-curve-getendparam obj)
para (vlax-curve-getstartparam obj)
  )
  (while (< para endpara)
    (setq seglist (cons (list (vlax-curve-getpointatparam obj para)
      (vlax-curve-getpointatparam obj (1+ para))
      (vla-getbulge obj para)
)
seglist
  )
  para   (1+ para)
    )
  )
  (reverse seglist)
)
<HR></font></BLOCKQUOTE><font size="2" face="Arial">

---

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Bei 'noch nicht sooo fit' sollte das Wissen um löschen eines Objektes unbedingt vorhanden sein,
entdel oder vla-delete sind zwei Möglichkeiten, die erste wäre hier wohl am einfachsten zu ergänzen.
Entdel ist in der Hilfe beschrieben und Beispiele im Netz sind in Unmengen vorhanden.

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

Ok, da muss ich passen. Mit nicht sooo Fit war auch vielmehr gemeint das sich meine Kenntnisse auf das schreiben einer Command Zeile beschränken. Nicht viel aber immerhin. Ich bin da eher das Skriptkid, dass sich LispŽs zusammenkopiert oder einfach das nutzt was es im Netz zu finden gibt.

P.S. Das Tool tut es erst mal auch so. Ich hab zwar keine Ahnung wo und wie ich entdel einbauen müsste. Probiere aber trotzdem mal es hin zu bekommen. Wenn ichs geschafft habe poste ich es hier ;-)

Danke für den Ansporn
Jörg

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Zitat:

---

Original erstellt von C4DP4P57:
Ich hab zwar keine Ahnung wo und wie ich entdel einbauen müsste. Probiere aber trotzdem mal es hin zu bekommen.

---

Ist nicht so schwer. Überlege mal, wann Du das Objekt nicht mehr brauchst und dann schau z. B. mal hier in die Hilfe zum Aufruf von entdel.

Gruß
Thomas

[Diese Nachricht wurde von spider_dd am 26. Okt. 2015 editiert.]

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

---

Zitat:

---

Original erstellt von spider_dd:

Ist nicht so schwer. Überlege mal, wann Du das Objekt nicht mehr brauchst und dann schau z. B. mal hier in die Hilfe zum Aufruf von entdel.

Gruß
Thomas

[Diese Nachricht wurde von spider_dd am 26. Okt. 2015 editiert.]

---

Also einfügen würde ich es wohl am Ende der Lisp, also wenn das neue Objekt erstellt ist?!
Ich habe jetzt mal ein wenig mit entdel rumprobiert, aber weiter wie (entdel (entlast)), was mir ja nur das letzte Objekt löscht, bin ich nicht gekommen. Ich verstehe nicht wie ich mit ssget das Quellobjekt wählen kann, wenn das überhaupt der richtige Weg wäre?
Respekt an alle die Lisp verstehen! Ich finde es schwer, aber probiere mal weiter ;-)

Gruß
Jörg

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Zug wackelt, Handydisplay klein, kein Acad zum testen,  aber:

Ist die zunächst gewählte Polylinie das Objekt um das es geht? Der Objektname wird in der Variable "ename" gespeichert, entdel verlangt so eine Angabe, daher sollte (entdel ename) zum Ziel führen, teste es mal.
prinzipiell würde ich auch eine Stelle wählen nach der Erstellung der neuen Kontur.

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

Hallo Jörg,

probiere mal folgendes:

Code:

---

(defun c:test (/ ename)
  (if (= "CW" (getdir-pline (setq ename (car (entsel "\nPline wählen:")))))
    (vla-offset (vlax-ename->vla-object ename) 2.0)
    (vla-offset (vlax-ename->vla-object ename) -2.0)
  )
  (entdel ename)
  (princ)
)

...

---

HTH
Gruß
Thomas

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

---

Zitat:

---

Original erstellt von spider_dd:
Hallo Jörg,

probiere mal folgendes:

Code:

---

(defun c:test (/ ename)
  (if (= "CW" (getdir-pline (setq ename (car (entsel "\nPline wählen:")))))
    (vla-offset (vlax-ename->vla-object ename) 2.0)
    (vla-offset (vlax-ename->vla-object ename) -2.0)
  )
  [b](entdel ename)
  (princ)
)

...

---

HTH
Gruß
Thomas[/B]

---

Hallo Thomas,
genau so funktioniert es    Mega Hammer Fett!!! Genau das was ich brauche.
Vielen vielen Dank, ihr seit Spitze 

Gruß
Jörg

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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