Hot News aus dem CAD.de-Newsletter:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Auswahl für 3D zu 2D Polylinie

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
Autor Thema:   Auswahl für 3D zu 2D Polylinie (108 mal gelesen)
silcono
Mitglied
Planer


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

Beiträge: 87
Registriert: 19.12.2014

AutoCAD 2010 LT
AutoCAD 2014
AutoCAD 2018
AutoCAD MAP 3D 2017
Intel(R) Core(TM) i5-4570 CPU @ 3.20GhZ 3.20Ghz
16,00GB Ram
Windows 7- Prof. 64-Bit
ASUS EAH6450 Series

erstellt am: 05. Dez. 2018 06:50    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 zusammen,

zu kurzen Erklärung: ich bekomme aus eine Datei. Diese enthält 3D-Poylinien und diese will ich zu 2D-Polylinien konvertieren.
Ich habe hierfür auch schon eine kleine Routine von Tony Hotchkiss im Netz gefunden:

Code:

(defun pline-3d-2d ()
  (vl-load-com)
  (setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
      ) ;_ end of vla-get-activedocument
*modelspace*  (vla-get-ModelSpace *thisdrawing*)
  ) ;_ end of setq
  (setq 3d-pl-list
(get-3D-pline)
  ) ;_ end of setq
  (if 3d-pl-list
    (progn
      (setq vert-array-list (make-list 3d-pl-list))
      (setq n (- 1))
      (repeat (length vert-array-list)
(setq vert-array (nth (setq n (1+ n)) vert-array-list))
(setq lyr (vlax-get-property (nth n 3d-pl-list) 'Layer))
(setq obj (vla-AddPolyline *modelspace* vert-array))
(vlax-put-property obj 'Layer lyr)
      ) ;_ end of repeat
      (foreach obj 3d-pl-list (vla-delete obj))
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of pline-3d-2d

(defun get-3D-pline ()
  (setq pl3dobj-list nil
obj     nil
3d     "AcDb3dPolyline"
  ) ;_ end of setq
  (setq selsets (vla-get-selectionsets *thisdrawing*))
  (setq ss1 (vlax-make-variant "ss1"))
  (if (= (vla-get-count selsets) 0)
    (setq ssobj (vla-add selsets ss1))
  ) ;_ end of if
  (vla-clear ssobj)
  (setq Filterdata (vlax-make-variant "POLYLINE"))
  (setq no-ent 1)
  (while no-ent
    (vla-Selectonscreen ssobj)
    (if (> (vla-get-count ssobj) 0)
      (progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
  (setq
    obj (vla-item ssobj
  (vlax-make-variant (setq i (1+ i)))
) ;_ end of vla-item
  ) ;_ end of setq
  (cond
    ((= (vlax-get-property obj "ObjectName") 3d)
    (setq pl3dobj-list
    (append pl3dobj-list (list obj))
    ) ;_ end of setq
    )
  ) ;_ end-of cond
) ;_ end of repeat
      ) ;_ end of progn
      (prompt "\nNo entities selected, try again.")
    ) ;_ end of if
    (if (and (= nil no-ent) (= nil pl3dobj-list))
      (progn
(setq no-ent 1)
(prompt "\nNo 3D-polylines selected.")
(quit)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while 
  (vla-delete (vla-item selsets 0))
  pl3dobj-list
) ;_ end of get-3D-pline


(defun get-3D-pline-old ()
  (setq no-ent 1)
  (setq filter '((-4 . "<AND")
(0 . "POLYLINE")
(70 . 8)
(-4 . "AND>")
)
  ) ;_ end of setq
  (while no-ent
    (setq ss       (ssget filter)
  k       (- 1)
  pl3dobj-list nil
  obj       nil
  3d       "AcDb3dPolyline"
    ) ;_ end-of setq
    (if ss
      (progn
(setq no-ent nil)
(repeat (sslength ss)
  (setq ent (ssname ss (setq k (1+ k)))
obj (vlax-ename->vla-object ent)
  ) ;_ end-of setq
  (cond
    ((= (vlax-get-property obj "ObjectName") 3d)
    (setq pl3dobj-list
    (append pl3dobj-list (list obj))
    ) ;_ end of setq
    )
  ) ;_ end-of cond
) ;_ end-of repeat
      ) ;_ end-of progn
      (prompt "\nNo 3D-polylines selected, try again.")
    ) ;_ end-of if
  ) ;_ end-of while
  pl3dobj-list
) ;_ end of get-3D-pline-old

(defun make-list (p-list)
  (setq i (- 1)
vlist nil
calist nil
  ) ;_ end of setq
  (repeat (length p-list)
    (setq obj (nth (setq i (1+ i)) p-list)
  coords (vlax-get-property obj "coordinates")
  ca (vlax-variant-value coords)
    ) ;_ end-of setq
    (setq calist (append calist (list ca)))
  ) ;_ end-of repeat
) ;_ end-of make-list

(defun c l32 ()
  (pline-3d-2d)
  (princ)
) ;_ end of pl32

(prompt "Enter PL32 to start: ")


Ein bisschen Lispeln kann ich, aber mit vla, vlax...usw. da bin ich erst noch am werden.
Ich möchte jetzt eine Auswahl schon innerhalb der Lisp anwenden, wie z.B.:

Code:

(setq 3dpoly (ssget "X" '((0 . "Polyline")(8 . "meinLayer"))))

Eventuell bin ich in der Funktion "get-3D-pline" oder "get-3D-pline-old" richtig, aber wie ich das verbaue, da bräuchte ich ein bisschen Unterstützung.

Im Voraus besten Dank und einen guten Start in den Tag!

Grüße Silcono

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: 1637
Registriert: 11.10.2004

Window 8.1
ACAD 2012-2019
CIVIL 2012 - 2019
BricsCAD V14-V18
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050

erstellt am: 05. Dez. 2018 08: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 silcono 10 Unities + Antwort hilfreich

Hallo Silcono,
ich habe ein Beispiel geschrieben, wie aus einer 3D-Polylinie eine LW-Polylinie wird. Zu beachten: die Höheninformationen der einzelnen Stützpunkte gehen verloren, die Erhebung der neuen LW-Polylinie ist 0.0.
Aber Du kannst es Dir mal anschauen und anpassen. Ich habe einen schnellen Test gemacht, scheint zu funktionieren:
Code:

(defun c:3pl2Lw ( / AWS AWSLIST SPACE VLA-OBJ)
  (if (and(setq aws (ssget (list (cons 0 "POLYLINE"))))
          (setq awsList (JB_3pl2lw:awsList aws)))
    (progn
      (setq space(vla-get-modelSpace (vla-get-activeDocument (vlax-get-acad-object))))
      (mapcar '(lambda(vla-obj)
                (vla-addLightweightPolyline space (JB_3pl2Lw:coordinates:array vla-obj))
                (vla-put-layer (vlax-ename->vla-object(entlast))
                  (vla-get-layer vla-obj))
                ;;;Hier können noch weitere Eigenschaften übertragen werden, z.B.
                ;;;Closed, Lineweigth, ...
                (vla-delete vla-obj)
                )
        awsList))
    (alert "keine 3D-Polylinien ausgewählt.")
    )
  (princ))


(defun JB_3pl2lw:awsList (aws / N RETLIST)
  (setq n 0)
  (repeat (sslength aws)
    (if (=(vla-get-Objectname (vlax-ename->vla-object(ssname aws n)))"AcDb3dPolyline")
      (setq RetList (cons (vlax-ename->vla-object(ssname aws n)) RetList)))
    (setq n (+ n 1)))
  RetList)

             
(defun JB_3pl2Lw:coordinates:array (vla-obj / KOORDSARRAY N RETLIST SUB X)
  (setq n 0)
  (mapcar '(lambda(X)
            (setq n (+ n 1))
            (if (= n 3)
              (setq RetList (cons (reverse Sub)RetList)
                    n 0
                    Sub nil)
              (setq Sub (cons X Sub))))
    (vlax-get vla-obj 'Coordinates))

  (setq RetList(reverse RetList))

  (setq KoordsArray (vlax-make-safearray vlax-vbDouble (cons 0  (-(*(length RetList)2)1))))
  (vlax-safearray-fill KoordsArray (apply 'append RetList))
  )


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

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

Foto-Manager Youtube

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

silcono
Mitglied
Planer


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

Beiträge: 87
Registriert: 19.12.2014

AutoCAD 2010 LT
AutoCAD 2014
AutoCAD 2018
AutoCAD MAP 3D 2017
Intel(R) Core(TM) i5-4570 CPU @ 3.20GhZ 3.20Ghz
16,00GB Ram
Windows 7- Prof. 64-Bit
ASUS EAH6450 Series

erstellt am: 05. Dez. 2018 09:40    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

Guten Morgen @joern bosse,

vielen Dank für deinen Beispiel-Code.
Funktioniert auch soweit.

Aber bzgl. meiner Frage hilft mir das leider nicht weiter 

Grüße
Silcono

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

CADwiesel
Moderator
CAD4FM UG




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

Beiträge: 1857
Registriert: 05.09.2000

AutoCAD, Bricscad
Wir machen das Mögliche unmöglich

erstellt am: 05. Dez. 2018 10:03    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 silcono 10 Unities + Antwort hilfreich

in der Funktion get-3d-pline ersetzt du den code
Code:
(cond
            ((= (vlax-get-property obj "ObjectName") 3d)
                (setq pl3dobj-list
                      (append pl3dobj-list (list obj))
                ) ;_ end of setq
            )
          )

durch diesen:
Code:
(cond
            ((and
              (= (vlax-get-property obj "ObjectName") 3d)
              (=(strcase(vla-get-Layer obj))"DEINLAYERNAME")
            )
                (setq pl3dobj-list
                      (append pl3dobj-list (list obj))
                ) ;_ end of setq
            )
          )

in der Funktion get-3D-pline-old brauchst du nur die Filterliste um den Layer zu erweitern

Code:
(setq filter '((-4 . "<AND")
                    (0 . "POLYLINE")
                    (8 . "DEINLAYERNAME")
                    (70 . 8)
                    (-4 . "AND>")
                )
  )

------------------
Gruß
CADwiesel
Besucht uns im CHAT

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

silcono
Mitglied
Planer


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

Beiträge: 87
Registriert: 19.12.2014

AutoCAD 2010 LT
AutoCAD 2014
AutoCAD 2018
AutoCAD MAP 3D 2017
Intel(R) Core(TM) i5-4570 CPU @ 3.20GhZ 3.20Ghz
16,00GB Ram
Windows 7- Prof. 64-Bit
ASUS EAH6450 Series

erstellt am: 05. Dez. 2018 10:04    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

Dankeschön CADwiesel,

das wars 

Grüße

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)2018 CAD.de | Impressum | Datenschutz