Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Schneller stutzen

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:  Schneller stutzen (2099 mal gelesen)
MARTINLE
Mitglied
Tischler


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

Beiträge: 485
Registriert: 18.10.2007

AUTOCAD 2016,
MS Windows7, 64-bit

erstellt am: 11. Sep. 2013 16:28    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

Hallo!

Ein ähnlicher Befehl zu meinem ist in den Expresstool "Extrim". Dieser stutz alle Objekte innerhalb oder außerhalb eines Objektes.

Dieses Lisp spart einen Klick und macht folgendes: Man hat z. B. ein Rechteck und eine Linie läuft durch das Rechteck.
Nun kann man die Linie links vom Rechteck bis zur rechten Kante des Rechteckes stutzen. Also bleibt nur mehr der rechte Teil der Linie rechts vom Rechteck stehen.Der Linke Teil UND der Teil in der Mitte vom Rechteck wird mit einem Klick gelöscht. 

Beim normalen Stutzen Befehl in ACAD kann man nur das Rechteck als gesamtes auswählen und muß dann noch zwei mal klicken bis man am Ziel ist.

Meine Frage: Das Lisp funktioniert zwar tadellos aber es ist nicht schön geschrieben (hab halt nur kopiert und probiert).
Wäre toll wenn jemand für die Allgemeinheit in diesem Forum mal drüberschaun und es besser schreiben könnte.
lg. Martin

(vl-load-com)
(defun c:Polystutzen ( / PL-OBJ PKT PARAM PRE SUF )
(command "_ucs" "w") 
(if(and(setq PL-OBJ(entsel "\nPolyliniensegment wählen : "))
        (setq PKT(cadr PL-OBJ))
        (setq PL-OBJ (car PL-OBJ))
        (setq PL-OBJ(cond                                        ;_ VLA-OBJEKT erzeugen
                      ((=(type PL-OBJ) 'VLA-OBJECT) PL-OBJ)
                      ((=(type PL-OBJ) 'Ename) (vlax-ename->vla-object PL-OBJ))   
                    )
        )       
        (setq PKT  (vlax-curve-getClosestPointTo PL-OBJ PKT))
        (setq PARAM(vlax-curve-getparamAtPoint PL-OBJ PKT))
        (setq PRE(vlax-curve-getpointatparam PL-OBJ (fix PARAM)))
        (setq SUF(vlax-curve-getpointatparam PL-OBJ (1+(fix PARAM))))       
    )
(COMMAND "_.line" (TRANS PRE 0 1) (TRANS SUF 0 1) "")
    (progn     
      (princ (strcat "\n KLICKPUNKT        : "(vl-princ-to-string  PKT)))
      (princ (strcat "\n SEGMENT-STARTPUNKT : "(vl-princ-to-string  PRE)))
      (princ (strcat "\n SEGMENT-ENDPUNKT  : "(vl-princ-to-string  SUF)))      (princ)
    ) 
  ) 
(command "stutzen" "L" "")
(while(/=(getvar "CMDACTIVE")0)(command pause))
(command "löschen" "L" "")
(command "_ucs" "vo")
)

 

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 12. Sep. 2013 07:43    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 MARTINLE 10 Unities + Antwort hilfreich

Hallo Martin,
ich habe es mal versucht.
Folgende Änderungen:
- BKS oder WKS ist nicht wichtig, es wird grundsätzlich in Weltkoordinaten agiert.
- Ini und ReIni-Funktion, dort kann z.B. CMDECHO auf 0 gestellt werden, damit die Eingabezeile nur die wichtigen Meldungen enthält.
- Undo (Beginn und End) gesetzt, ansonsten würde bei einmal Z noch die temporäre Linie vorhanden sein
- Gesamtfunktion mit vl-catch-all-apply abfangen (ist zwar nicht wirklich wichtig, aber so kannst Du auch mit ESC zwischendurch alles "ordentlich" beenden.

Code:

(vl-load-com)
(defun c:Polystutzen ( / PL-OBJ PKT PARAM PRE SUF)
  (Polystutzen:Ini '(("CMDECHO" 0)))
 
  (if(vl-catch-all-error-p
      (vl-catch-all-apply '(lambda()
        (if(and(setq PL-OBJ(entsel "\nPolyliniensegment wählen : "))
(setq PKT (cadr PL-OBJ))
(setq PL-OBJ (car PL-OBJ))
(setq PL-OBJ(vlax-ename->vla-object PL-OBJ))
(setq PARAM(vlax-curve-getparamAtPoint PL-OBJ
    (vlax-curve-getClosestPointTo PL-OBJ PKT)))
(setq PRE(vlax-curve-getpointatparam PL-OBJ (fix PARAM)))
(setq SUF(vlax-curve-getpointatparam PL-OBJ (1+(fix PARAM)))))
  (progn
    (entmake (list (cons 0 "LINE")(cons 10 PRE)(cons 11 SUF)))
    (setq LINE-NEW (entlast))
    (redraw LINE-NEW 3)
    (princ "\nZu stutzende Objekte wählen:")
    (command "_.trim" LINE-NEW "")
    (while(/=(getvar "CMDACTIVE")0)(command pause))
    (entdel LINE-NEW))
  (princ "\nKein Polyliniensegment gewählt.")))))
    (progn
      (if LINE-NEW (entdel LINE-NEW))
      (Polystutzen:ReIni)
      (princ "\nFunktion \"Polystutzen\" abgebrochen."))
    (progn
      (Polystutzen:ReIni)
      (princ "\nFunktion \"Polystutzen\" beendet.")))
  (princ)
  )

(defun Polystutzen:Ini (SysVarList / )
 
  (setq SysVar$$Before(mapcar '(lambda(A)
(list (car A)(getvar (car A))))SysVarList))
  (mapcar '(lambda(A)
    (setvar (car A)(cadr A)))SysVarList)
  (command "_.undo" "_be"))

(defun Polystutzen:ReIni ( / )
  (command "_.undo" "_e")
  (mapcar '(lambda(A)
    (setvar (car A)(cadr A)))SysVar$$Before)
  )


viel Spaß damit.

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Kordinaten einlesen Youtube

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

MARTINLE
Mitglied
Tischler


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

Beiträge: 485
Registriert: 18.10.2007

AUTOCAD 2016,
MS Windows7, 64-bit

erstellt am: 12. Sep. 2013 07:58    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

Hallo Jörn

Danke für das profimäßige umsetzen.
Funktioniert super!!
Damit hab hoffentlich nicht nur ich Spass.
Dafür gibt es natürlich  die vollen Uuuu's

Danke!

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

MARTINLE
Mitglied
Tischler


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

Beiträge: 485
Registriert: 18.10.2007

AUTOCAD 2016,
MS Windows7, 64-bit

erstellt am: 12. Sep. 2013 13:52    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

Hallo Jörn!

Ich bins nochmal.
Mir ist aufgefallen, wenn ich im BKS (180° gedreht) unterwegs bin wird mir beim markieren senkrechter Objekte (Y-Richtung) das  falsche Segment markiert. Im gleichen BKS horizontal wird das richtige markiert. 
Kann es sein, dass die Vekoren des gewählten Segmentes nicht richtig umgewandelt werden?

lg. Martin 

edit: Vertikal und auch horizontal wird immer nur das untere horizontale Segment markiert!

[Diese Nachricht wurde von MARTINLE am 12. Sep. 2013 editiert.]

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 12. Sep. 2013 14:14    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 MARTINLE 10 Unities + Antwort hilfreich

Hallo Martin,
da hat noch ein TRANS gefehlt, der Funktion vlax-curve-getClosestPointTo müssen Weltkoordinaten übergeben werden.

=>(vlax-curve-getClosestPointTo PL-OBJ (trans PKT 1 0))


Code:

(vl-load-com)
(defun c:Polystutzen ( / PL-OBJ PKT PARAM PRE SUF)
  (Polystutzen:Ini '(("CMDECHO" 0)))

  (if(vl-catch-all-error-p
      (vl-catch-all-apply '(lambda()
        (if(and(setq PL-OBJ(entsel "\nPolyliniensegment wählen : "))
(setq PKT (cadr PL-OBJ))
(setq PL-OBJ (car PL-OBJ))
(setq PL-OBJ(vlax-ename->vla-object PL-OBJ))
(setq PARAM(vlax-curve-getparamAtPoint PL-OBJ
    (vlax-curve-getClosestPointTo PL-OBJ (trans PKT 1 0))))
(setq PRE(vlax-curve-getpointatparam PL-OBJ (fix PARAM)))
(setq SUF(vlax-curve-getpointatparam PL-OBJ (1+(fix PARAM)))))
  (progn
    (entmake (list (cons 0 "LINE")(cons 10 PRE)(cons 11 SUF)))
    (setq LINE-NEW (entlast))
    (redraw LINE-NEW 3)
    (princ "\nZu stutzende Objekte wählen:")
    (command "_.trim" LINE-NEW "")
    (while(/=(getvar "CMDACTIVE")0)(command pause))
    (entdel LINE-NEW))
  (princ "\nKein Polyliniensegment gewählt.")))))
    (progn
      (if LINE-NEW (entdel LINE-NEW))
      (Polystutzen:ReIni)
      (princ "\nFunktion \"Polystutzen\" abgebrochen."))
    (progn
      (Polystutzen:ReIni)
      (princ "\nFunktion \"Polystutzen\" beendet.")))
  (princ)
  )

(defun Polystutzen:Ini (SysVarList / )

  (setq SysVar$$Before(mapcar '(lambda(A)
(list (car A)(getvar (car A))))SysVarList))
  (mapcar '(lambda(A)
    (setvar (car A)(cadr A)))SysVarList)
  (command "_.undo" "_be"))

(defun Polystutzen:ReIni ( / )
  (command "_.undo" "_e")
  (mapcar '(lambda(A)
    (setvar (car A)(cadr A)))SysVar$$Before)
  )


------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Kordinaten einlesen Youtube

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

MARTINLE
Mitglied
Tischler


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

Beiträge: 485
Registriert: 18.10.2007

AUTOCAD 2016,
MS Windows7, 64-bit

erstellt am: 12. Sep. 2013 14:41    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

Hallo Jörn,
Mann bist du schnell.
Danke schön jetzt passt es.

Lg. Martin

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

cadplayer
Ehrenmitglied
CADniker


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

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 13. Sep. 2013 08:30    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 MARTINLE 10 Unities + Antwort hilfreich

Klasse Beitrag - super gelöst Jörn, dein Vorschlag bringt mir ganz neue Ideen... mit redraw zu hantieren:

Zitat:
(progn
                                          (entmake (list (cons 0 "LINE")(cons 10 PRE)(cons 11 SUF)))
                                          (setq LINE-NEW (entlast))
                                          (redraw LINE-NEW 3)
                                          (princ "\nZu stutzende Objekte wählen:")
                                          (command "_.trim" LINE-NEW "")

find ich toll, wie du einfach die Bruchkante sichtbar machst.

------------------
Gruss Dirk

http://cadplayerlounge.blogspot.se

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

MARTINLE
Mitglied
Tischler


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

Beiträge: 485
Registriert: 18.10.2007

AUTOCAD 2016,
MS Windows7, 64-bit

erstellt am: 13. Sep. 2013 08:47    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

Hallo Dirk

.........bringt mir ganz neue Ideen...

Welche? Schreib sie doch hier rein dann können wir vielleicht alle was lernen.

lg. Martin 

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

cadplayer
Ehrenmitglied
CADniker


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

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 13. Sep. 2013 12:26    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 MARTINLE 10 Unities + Antwort hilfreich

Sicher...nur am Rand redraw find ich ganz interessant, wenn man Objekte mit entsel auswählt und markiert... passt aber hier nicht ganz rein - könnte man mal einen neuen thread aufmachen...

Die idee ist noch am reifen, sprich ist noch nix auf Papier

------------------
Gruss Dirk

http://cadplayerlounge.blogspot.se

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