Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Lisp für Rohransichten verschwunden ?

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:  Lisp für Rohransichten verschwunden ? (1379 mal gelesen)
andi2050
Mitglied



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

Beiträge: 107
Registriert: 11.03.2003

erstellt am: 31. Mrz. 2003 19:29    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

Hi Forum

Heute wurde ein Beitrag mit dem Betreff: "Lisp zum zeichnen von Rohransichten" gepostet.

Ich habe mir daraufhin die Mühe gemacht, eine Anwort mit LISP-Programm zu erstellen.
Als ich die Antwort abschicken wollte, war der Beitrag verschwunden.

Damit zumindest das LISP Programm aus der Zwischenablage befreit wird  , habe ich diesen neuen Beitrag erstellt.

Grüße
Andi

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

andi2050
Mitglied



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

Beiträge: 107
Registriert: 11.03.2003

erstellt am: 31. Mrz. 2003 19:31    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

Hi Mario

Ich habe mir erlaubt Dein LISP etwas abzuändern !
Es ginge zwar noch etwas eleganter, aber auf die schnelle...

Wenn ich richtig verstanden habe, dann soll die Ursprungslinie am aktuellen Layer bleiben und die neuen Linien auf dem neuen Layer liegen.
Der Layer wird im LISP erstellt, aber nicht aktiviert.
Nachdem das neue Element erstellt wurde wird der Layer des Elements geändert.
Das hat den Vorteil, daß bei einem Programmabbruch nicht der Layer "005b...." aktiv ist, sondern der aktuelle Layer.
Dann hättest Du bald den schönsten Layersalat in der Zeichung, wenn der Benutzer nicht aufpaßt.

Was mich ein bisserl stört:
Der äußerste Linienabstand entspricht nicht genau dem Eingegebenen Rohrradius,
weil Du durch den Wert 2.84... und das inkrementale Versetzen von innen heraus einen Rundungsfehler erzeugst !
Wenn Du mir die Herleitung des 2.8er Werts geben würdest könnte man das eleganter machen.
(Bei iterativ hergeleiteten Zahlenreihen bin ich immer etwas Denkfaul)

Einige Deiner SETQ anweisungen habe ich rausgenommen, da sie überflüssig waren.


(defun c:Rohransicht (/ ent dis stp stp2 intval)
;;; Variablen deklarieren sonst bleiben sie nach Beenddigung erhalten -> Globale Var.
  (setvar "CMDECHO" 0)
;;; Layer erstellen, wenn nicht vorhanden
  (if (not (tblsearch "LAYER" "005b_Rohransicht"))
    (command "_-LAYER"       "_N"       "005b_Rohransicht"
    "_C"       "252"       "005b_Rohransicht"
    "_LT"       "CONTINUOUS"    "005b_Rohransicht"
    "_LW"       "0.05"       "005b_Rohransicht"
    ""
    )
  )
;;;getdist - auch eingabe durch picken möglich !
  (setq dis (/ (getdist "Rohrradius eingeben: ") 2.84982))
  (setq ent (entsel "\nZeige zu versetzendes Objekt: "))
  (setq stp (getpoint "\nAuf welche Seite? Seite 1 "))
  (setq stp2 (getpoint "\nAuf welche Seite? Seite 2 oder SPACE für keine"))
  (setq intval dis)
  (repeat 10
    (command "_OFFSET" intval ent stp "")
;;;letztes Element Layer ändern
    (entmod
      (subst (cons 8 "005b_Rohransicht") (assoc 8 (entget (entlast))) (entget (entlast)))
    )
    (if stp2
      (progn (command "_OFFSET" intval ent stp2 "")
;;;letztes Element Layer ändern
    (entmod (subst (cons 8 "005b_Rohransicht")
    (assoc 8 (entget (entlast)))
    (entget (entlast))
    )
    )
      )
    )
    (setq intval (* 0.75 (+ intval dis)))
  )
  (princ)
)


Falls Du noch Fragen dazu hast, Bitte posten...

Grüße
Andi

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

Mario Scht
Mitglied



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

Beiträge: 156
Registriert: 14.11.2002

Win XP
ACAD 2007

erstellt am: 01. Apr. 2003 11:01    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 andi2050 10 Unities + Antwort hilfreich

Hallo Andi,

danke vorab für Deine Bemühungen.
Ich bin absoluter Lisp-Anfänger und habe die Aufgabe ins Netz gestellt, da ich nach anfänglichen Extemschwierigkeiten keine andere Hoffnung sah. Dann kam ich auf den Befehl COMMAND und nach geraumer Tüftelei hat er genau das gemacht, was ich wollte.
Dann habe ich mal drauf los geschrieben und es hat geklappt. Da ich das Forum nicht vollpflastern wollte habe ich den Beitrag wieder entfernt.

Anbei mein Code. Er erstellt gleich die zugehörigen Layer und legt alle entsprechenden Linien auf diesen ab (Achse, Außenkante, Ansichtslinien)
Das ganze klappt auch mit Polylinien, was die Arbeit bei rundungen erleichtert.

Einziger Nachteil, ich muss angeben, auf welche Seiten der Achse er die Linien zeichnen soll, da dies aber eigentlich klar ist, wäre es schön, wenn sich jemand fände, der die Koordinatenabfrage über GETPOINT für die Variablen STP und STP2 überflüssig macht. Danke vorab.

------------------------------
(defun c:Rohransicht ()

(command "-layer" "neu" "018_Rohrleitungen" "se" "018_Rohrleitungen" "fa" "53" "" "lt" "Continuous" "" "ls" "0.09" "" "" "")
(command "-layer" "neu" "018a_Rohrachsen" "se" "018a_Rohrachsen" "fa" "1" "" "lt" "ACAD_ISO10W100" "" "ls" "0.15" "" "" "")
(command "-layer" "neu" "018b_Rohransicht" "se" "018b_Rohransicht" "fa" "252" "" "lt" "Continuous" "" "ls" "0.05" "" "" "")

(setq ent (entsel "\nZeige zu versetzendes Objekt: "))
(setq dis0 (getreal "Rohrradius eingeben: "))
(setq dis (/ dis0 2.88))
(setq stp (getpoint "Auf welche Seite? Seite 1 "))
(setq stp2 (getpoint "Auf welche Seite? Seite 2 oder SPACE für keine"))

    (command "_change" ent "" "EI" "la" "018a_Rohrachsen" "" "" "" "" "" "" "")
    (command "_copy" ent "" "@" "@")
    (command "_change" "v" "" "EI" "la" "018_Rohrleitungen" "" "" "" "" "" "" "")
    (command "versetz" dis0 ent stp "")
    (command "versetz" dis0 ent stp2 "")
(setq intval dis)
(setq intval2 dis)
    (command "_change" "v" "" "EI" "la" "018b_Rohransicht" "" "" "" "" "" "" "")
  (repeat 10
    (command "versetz" intval ent stp "")
    (setq intval (+ intval dis))
    (setq intval (* intval 0.75))
    (command "versetz" intval2 ent stp2 "")
    (setq intval2 (+ intval2 dis))
    (setq intval2 (* intval2 0.75))
  )
    (command "_erase" ent "")
)

----------------------------


Deine Routine zur Layererstellung werde ich versuchen hineinzubasteln, da ich einen Putzfimmel für *.dwg's und Layerstrukturen habe :-). Was ich manchmal von anderen Büros zugeschickt bekomme, treibt mir die Grätze auf die Maus.

In meinem Lisp erzeugt er die Layer jedes Mal, das kostet Zeit und ich werde es ändern.

Den Linienabstand habe ich jetzt auch auf das exakte Maß gebracht.

Ordentlich U's sind Dir sicher

Grüße
Mario

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

Mario Scht
Mitglied



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

Beiträge: 156
Registriert: 14.11.2002

Win XP
ACAD 2007

erstellt am: 01. Apr. 2003 11:53    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 andi2050 10 Unities + Antwort hilfreich

Hallo Andi,

habe hier den Code bereit mit einigen Deiner Hilfestellungen verfeinert. Ist zwar nochimmer eher ein MAKRO, als ein LISP, aber es funktioniert tadellos, bis auf den Aspekt, dass ich die Seiten nach wie vor angeben muss, auf die kopiert werden soll (Siehe oben!). 

Grüße Mario

;;; --------------------------------------------------------
;;; Variablen deklarieren sonst bleiben sie nach Beenddigung erhalten -> Globale Var.
(defun c:Rohransicht (/ ent dis0 dis stp stp2 intval intval2)

;;; Textfeldmeldungen ausschalten?
(setvar "CMDECHO" 0)

;;; Layer erstellen, wenn nicht vorhanden------------------------------
(if (not (tblsearch "LAYER" "018_Rohrleitungen"))
    (command
    "_-LAYER" "_N"              "018_Rohrleitungen"
    "_C"      "53"              "018_Rohrleitungen"
    "_LT"    "CONTINUOUS"      "018_Rohrleitungen"
    "_LW"    "0.09"            "018_Rohrleitungen"
    ""
    )
)
(if (not (tblsearch "LAYER" "018a_Rohrachsen"))
    (command
    "_-LAYER" "_N"              "018a_Rohrachsen"
    "_C"      "1"                "018a_Rohrachsen"
    "_LT"    "ACAD_ISO10W100"  "018a_Rohrachsen"
    "_LW"    "0.15"            "018a_Rohrachsen"
    ""
    )
)
(if (not (tblsearch "LAYER" "018b_Rohransicht"))
    (command
    "_-LAYER" "_N"              "018b_Rohransicht"
    "_C"      "252"              "018b_Rohransicht"
    "_LT"    "Continuous"      "018b_Rohransicht"
    "_LW"    "0.05"            "018b_Rohransicht"
    ""
    )
)
;;; -------------------------------------------------------------------


(setq ent (entsel "\nZeige zu versetzendes Objekt: "))
;;;getdist - auch eingabe durch picken möglich !
(setq dis0 (getdist "Rohrradius eingeben: "))
(setq dis (/ dis0 2.88))
(setq stp (getpoint "Auf welche Seite? Seite 1 "))
(setq stp2 (getpoint "Auf welche Seite? Seite 2 oder SPACE für keine"))


    (command "_change" ent "" "EI" "la" "018a_Rohrachsen" "")
    (command "_copy" ent "" "@" "@")
    (command "_change" "v" "" "EI" "la" "018_Rohrleitungen" "")
    (command "versetz" dis0 ent stp "")
    (command "versetz" dis0 ent stp2 "")
(setq intval dis)
(setq intval2 dis)
    (command "_change" "v" "" "EI" "la" "018b_Rohransicht" "")
(repeat 10
    (command "versetz" intval ent stp "")
    (setq intval (+ intval dis))
    (setq intval (* intval 0.75))
    (command "versetz" intval2 ent stp2 "")
    (setq intval2 (+ intval2 dis))
    (setq intval2 (* intval2 0.75))
)
    (command "_erase" ent "")
)


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

andi2050
Mitglied



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

Beiträge: 107
Registriert: 11.03.2003

erstellt am: 01. Apr. 2003 14:53    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

Hi Mario

Wird ja schon langsam...
Das mit dem vorher auf Durchmesser versetzen ist ne ganz gute Idee !
Eigentlich müßte dann aber (REPEAT 9 ...) ausreichen, sonst hast Du zwei knapp aneinander liegende Linien - kann beim Editieren Probleme geben.

Das mit den Seiten picken kann kann man schon wegsparen...
Dazu muß man aber wissen, aus welchen Elementen die Rohransicht erstellt werden soll (normale Linien/Bögen oder Polylinien)?
Ich vermute Du zeichnest erst eine Polylinie (LWPOLYLINIE ?)und wendest darauf Dein LISP an.
Außerdem gehe ich davon aus, daß immer auf 2 Seiten versetzt werden soll. (oder ?)

Warum verwendest Du intval UND intval2 ?
Eines von beiden würde doch reichen !

Bin Dir gerne behilflich, hab momentan genug Zeit !

Grüße
Andi

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

Mario Scht
Mitglied



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

Beiträge: 156
Registriert: 14.11.2002

Win XP
ACAD 2007

erstellt am: 01. Apr. 2003 15:49    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 andi2050 10 Unities + Antwort hilfreich

Hallo Andi,

Danke für das Angebot.
die sehr engen Linien außen sind erwünscht, da dadurch die räumliche Darstellung gut zur Geltung kommt. Auf Grund der sehr dünnen Linien sieht das ganze dann top aus.

Die Rohrachslininen sind immer _LINE oder _PLINE, die aus Linen und Kreisbögen zusammengesetzt sind. Da ich mit LT und LTExtender arbeite und die Hilfe nach LWPOLYLINIEN ohne Erfolg abgesucht habe, gehe ich davon aus, dass LT keine LWPOLYLINIEN hat.

Das Versetzen nach zwei Seiten ist zu 99,9% notwendig und das eine von 1000 Malen kann ich die überflüssigen Linien auch weglöschen.

Das mit INTVAL und INTVAL2 ergab sich so:
Ganz ursprünglich bestand der Code aus 6 Zeilen, die nicht aus meiner Feder waren. Der gesamte Programmablauf war äußerst umständlich und man mußte x-mal ausprobieren zwischen Linienanzahl, Inkrement, erstem Linienabstand usw., usf. bis dann die inkrementierten Linien endlich halbwegs zwischen das halbe Rohr paßten. Dann mußte man die Linien um die Achse spiegeln, was aber nur bei geraden Rohren Erfolg bringt. Bei einem Bogen klappt das ja nicht. Wie erwähnt, war es recht umständlich und langwierig anzuwenden, aber als Anstoß ausgezeichnet geeignet.
Dann ging meine Tüftelei los, ohne so richtig zu wissen, was ich da eigentlich mache.
Ich hatte auch mal eine Lösung, mit nur einer Varable, bei der allerdings wechelseitig jeweils eine Linie links und eine Linie rechts gezeichnet wurde, allerdings immer mit dem darauffolgenden Inkrement, was zu einer Asymmetrie führte, was absolut unerwünscht ist.
Dann kam ich auf die Idee, links das gleiche zu machen wie rechts, was sich letztlich in den zwei Variablen und dem doppelten GETPOINT äußert. Wenn es einfacher geht, bitte ich Dich darum. Mit maximaler Beschreibung dessen, was und Warum Du es getan hast.

So, nun kennst Du die ganze Geschichte :-)

Grüße Mario


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

andi2050
Mitglied



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

Beiträge: 107
Registriert: 11.03.2003

erstellt am: 02. Apr. 2003 09:46    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

Hi Mario

Das Programm ist etwas länger geworden...
Es werden zwei Punkte im senkrechten Abstand (1 ZE) zum Startpunkt des 1.Elements berechnet.
Den Rest hab ich etwas angepasst und 'geglättet' ist aber im Prinzip der gleiche Ablauf wie vorher.

Da der Versetz Befehl beim Auswählen der Seite auf den Objektfang zugreift, muß dieser zwischenzeitlich ausgeschaltet werden.
Je nach Ofang Einstellungen ging's auch ohne Ausschalten ist aber unsicher.

Das Programm enthält jetzt einige weitere Funktionen. Vorteil:
- Man braucht mehrfach verwendete Programmteile nur einmal schreiben.
- Außerdem wird das ganze übersichtlicher und überschaubarer.
Im laufe der Zeit sammeln sich so einige Funktionen an, die man immer wieder bei neuen Programmen brauchen kann. (So erspart man sich mächtig Arbeit)
Eigentlich mußte nur 'get_points_aside' neugeschrieben werden, alles andere hab ich mir zusammenkopiert.

COMMAND-Befehle sind sehr langsam in der Ausführung.
Alles was mit ENTMOD, ENTMAKE, ENTDEL... gemacht werden kann ist um ein vielfaches schneller
Außerdem gibts beim Wechsel auf neue ACAD Versionen manchmal Probleme, da teilweise die Parameter Bezeichnungen geändert werden.
z.B . beim  PEDIT Befehl hieß es früher 'E'ntscheitelpunkt, jetzt 'BE'arbeiten
ENTMAKE ertellt sich den Layer selbst, wenn er nicht existiert. COMMAND würde sich da querstellen...

Hab ein paar Kommentare eingefügt, damit der zumindest der Ablauf klarer wird.
Die genaue Funktionsweise aller Funktionen zu erklären wäre im Gesamten etwas zu umfangreich.
Schau's Dir mal in Ruhe an und dann Fragen...

Grüße
Andi


(defun c:rohransicht (/ ent dis stp osmod intval lay_leitung lay_achsen lay_ansicht)
;; Textfeldmeldungen ausschalten?  JA !
  (setvar "CMDECHO" 0)
  ;; einfacher, wenn Layernamen nachträglich geändert werden sollen
  (setq lay_leitung "018_Rohrleitungen"
lay_achsen  "018a_Rohrachsen"
lay_ansicht "018b_Rohransicht"
  )
;;; Layer erstellen, wenn nicht vorhanden------------------------------
(if (not (tblsearch "LAYER" lay_leitung))
  (command "_-LAYER" "_N"     lay_leitung
  "_C" "53"     lay_leitung
  "_LT" "CONTINUOUS" lay_leitung
  "_LW" "0.09"     lay_leitung
  ""
  )
)
(if (not (tblsearch "LAYER" lay_achsen))
  (command "_-LAYER" "_N"     lay_achsen
  "_C" "1"     lay_achsen
  "_LT" "ACAD_ISO10W100"
  lay_achsen "_LW"     "0.15"
  lay_achsen ""
  )
)
(if (not (tblsearch "LAYER" lay_ansicht))
  (command "_-LAYER" "_N"     lay_ansicht
  "_C" "252"     lay_ansicht
  "_LT" "Continuous" lay_ansicht
  "_LW" "0.05"     lay_ansicht
  ""
  )
)
;;; -------------------------------------------------------------------
;;;
  ;; while-Schleife: wenn danebengepickt, kein Programmabbruch
  (while (not ent)
    (princ "\nNoch nichts gewählt !")
    (setq ent (entsel "\nZeige zu versetzendes Objekt: "))
  )
  ;; Punkte links/rechts von Element berechnen -> siehe (defun get_points_aside ....)
    (setq stp (get_points_aside ent))
  ;;*Rohransicht_radius* ist Global, damit beim Neuaufruf der letzte Wert mit <ENTER> übernommen werden kann
  ;; Globale Variablen sollte man Sternchen kennzeichnen, damit man Sie besser erkennt
  (if (not (numberp *Rohransicht_radius*))
      ;; Defaultwert für Radius setzen, wenn Befehl 1.Mal aufgerufen wird.
    (setq *Rohransicht_radius* 10.0)
  )
  (if (not (setq
    dis (getdist (strcat "\nRohrradius  <" (rtos *Rohransicht_radius* 2 4) "> : "))
  )
      )
    (setq dis *Rohransicht_radius*)
    (setq *Rohransicht_radius* dis)
  )
  ;;Objektfang merken und ausschalten
  (setq osmod (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  ;; entmod_layer ist schneller als (COMMAND "_-LAYER"...) -> siehe (defun entmod_layer...)
  ;; COPY ist nicht nötig
  (entmod_layer ent lay_leitung)
  (command "_OFFSET" *Rohransicht_radius* ent (car stp) "")
  (command "_OFFSET" *Rohransicht_radius* ent (cadr stp) "")
  (entmod_layer ent lay_ansicht)
  ;; Berechnung von DIS erst hier erspart Umweg über DIS0
  (setq dis    (/ *Rohransicht_radius* 2.88)
intval dis
  )
  ;; Linien für Rohransicht zeichnen
  (repeat 10
    (command "_OFFSET" intval ent (car stp) "")
    (command "_OFFSET" intval ent (cadr stp) "")
    ;; berechnen nach 2.Versetz erspart INTVAL2
    (setq intval (* 0.75 (+ intval dis)))
  )
  ;;Objektfang zurücketzen
  (setvar "OSMODE" osmod)
  (entmod_layer ent lay_achsen)
  ;; princ: damit nichts an die Kommandozeile ausgegeben wird
  (princ)
)
;;; ------------------------------------------- ENDE Hauptfunktion C:Rohrleitung ------------------------------------------------
;;;
;;;************************************************************
;;; GET_POINTS_ASIDE - ermittelt je einen Punkt links und rechts
;;; des Startpunkts von 'ele' im Abstand von 1 ZE vom Startpunkt
;;; 'ent' - Nur POLYLINIE, LWPOLYLINIE oder LINE zulässig
;;; Rückgabewert: ((P1x P1y) (P2x P2y))
;;; Wenn falscher Elementtyp gewählt wurde bricht die Funktion
;;; das Programm mit (exit) ab.
;;;************************************************************
(defun get_points_aside (ent / seg vektor)
  (setq ent (get_assoc_list ent))
  ;; Start und Endpunkt von 1.Segment ermitteln -> seg = '(P1 P2 Bulge)
  ;; 'Bulge' ist die Ausbuchtung von Bögen in Polylinien Bulge=0.0 entpricht einer Linie
  (setq
    seg (cond ((test_entity ent "LINE")
      ;; Wenn LINE -> Linienendpunkte auslesen und Bulge 0.0 anhängen
      (list (cdr (assoc 10 ent)) (cdr (assoc 11 ent)) '0.0)
      )
      ((test_entity ent "POLYLINE")
      ;;Wenn POLYLINIE -> 1. und 2. Polylinienpunkt und Bulge auslesen
      (list (cdr (assoc 10 (next_vtx ent)))
    (cdr (assoc 10 (next_vtx (next_vtx ent))))
    (cdr (assoc 42 (next_vtx ent)))
      )
      )
      ((test_entity ent "LWPOLYLINE")
      ;;Wenn LWPOLYLINIE -> 1. und 2. Polylinienpunkt und Bulge auslesen
      (list (cdr (assoc 10 ent))
    (cdr (assoc 10 (cdr (member (assoc 10 ent) ent))))
    (cdr (assoc 42 ent))
      )
      )
      ;; wenn Falsches Element gewählt wurde -> Und Tschüß
      (T
      (alert "gewähltes Element ist keine\nLINIE, POLYLINIE oder LWPOLYLINIE")
      (exit)
      )
)
  )
  ;; Verschiebungsvektor mit Länge 1 berechnen
  (setq vektor (normvektor
;;wenn Bulge = 0 (gerade Linie)
(if (zerop (caddr seg))
  ;;dann Vektor 90 grad zu Linie
  (reverse (mapcar '* (2p->vektor (car seg) (cadr seg)) '(-1 1)))
  ;;sonst Vektor von Bogenzentrum -> Bogenstartpunkt
  (2p->vektor (get_cen_seg seg) (car seg))
)
      )
  )
  ;; Rückgabewerte (Liste aus 2 Punkten)  bilden
  (list ;; Verschiebungsvektor zu Startpunkt (car seg) addieren
(mapcar '+ (car seg) vektor)
;; und einmal subtrahieren
(mapcar '- (car seg) vektor)
  )
)
;;;-------------------------------------------------------------------------------------------------
;;; ------------------------------- Standardfunktionen ---------------------------------------------
;;;-------------------------------------------------------------------------------------------------
;;;
;;;************************************************************
;;; ENTMOD_LAYER - legt Zeichnungselement 'ent' auf 'new_layer'
;;;************************************************************
(defun entmod_layer (ent new_layer)
  (setq ent (get_assoc_list ent))
  (entmod (subst (cons 8 new_layer) (assoc 8 ent) ent))
)
;;;************************************************************
;;; GET_ASSOC_LIST - wandelt 'ent' in Assoziationsliste um (wenn nötig)
;;; 'ent' kann Ergebnis von (entsel), Objekname oder Assoziationsliste sein
;;;************************************************************
(defun get_assoc_list (ent)
  (if (listp ent)
    (if (= (type (car ent)) 'ename)
      (entget (car ent))
      ent
    )
    (entget ent)
  )
)

;;;************************************************************
;;; TEST_ENTITY - prüft, ob das Element 'ent'  vom Typ 'type' ist
;;;************************************************************
(defun test_entity (ent ent_type /) (= ent_type (cdr (assoc 0 (get_assoc_list ent)))))
;;;************************************************************
;;; NEXT_VTX - gibt nächstes VERTEX-Element von 'ent' zurück (assoc-Liste)
;;; für alte POLYLINE
;;;************************************************************
(defun next_vtx (ent) (entget (entnext (cdr (assoc -1 ent)))))
;;;************************************************************
;;; GET_CEN_SEG - gibt Radiusmittelpunkt von Bulge-Segment zurück
;;;************************************************************
(defun get_cen_seg (seg / p1 p2 cot)
  (setq p1  (car seg)
p2  (cadr seg)
cot (* 0.5 (- (/ 1.0 (last seg)) (last seg)))
  )
  (list (/ (- (+ (car p1) (car p2)) (* (- (cadr p2) (cadr p1)) cot)) 2.0)
(/ (+ (+ (cadr p1) (cadr p2)) (* (- (car p2) (car p1)) cot)) 2.0)
  )
)
;;;************************************************************
;;; diverse Vektorfunktionen
;;;************************************************************
(defun 2p->vektor (start end) (mapcar '- end start))
;;;
(defun betrag (vektor) (sqrt (apply '+ (mapcar '* vektor vektor))))
;;;
(defun normvektor (vektor)
  (mapcar '(lambda (comp) (* comp (/ 1.0 (betrag vektor)))) vektor)
)

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

Mario Scht
Mitglied



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

Beiträge: 156
Registriert: 14.11.2002

Win XP
ACAD 2007

erstellt am: 02. Apr. 2003 11:56    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 andi2050 10 Unities + Antwort hilfreich

Hi Andi,

ich geh ja fest :-)!!! Es ist doch tatsächlich immer wieder erstaunlich, was aus ursprünglichen 6 Zeilen werden kann. Es funktioniert tadellos und die sauberen Abbruchfunktionen sind ganz wichtig. Deine Kommentare sind ausgezeichnet nachvollziehbar. Falls Du kein Pädagoge bist, hast Du den Beruf verfehlt:-)

Da in LT keine LISP Hilfe enthalten ist, werde ich mir wohl erst einmal eine Befehlsübersicht zulegen.

Besten Dank und U's 4 U
Mario

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

andi2050
Mitglied



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

Beiträge: 107
Registriert: 11.03.2003

erstellt am: 02. Apr. 2003 12:12    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

Hi

Freut mich, da es funzt !

Wenn Du tiefer in LISP einsteigen willst, dann kann ich Dir die Seiten von 'mapcar' wärmstens empfehlen !
SUPER Tutorial !!
Leider momentan nicht erreichbar wg. Kriegsboykott - schade.
Kannst aber trotzdem mal reinschaun. http://www.tutorial.autolisp.info/

Hoffentlich ist mir 'mapcar' nicht böse daß ich hier einen link auf seine Seite gesetzt habe.

Grüße
Andi

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