| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| PNY präsentiert die neue NVIDIA RTX A400 und die A1000 Grafikkarte, eine Pressemitteilung
|
Autor
|
Thema: Polylinie mit Objektdaten in 3DPolylinie umwandeln (1198 / mal gelesen)
|
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 14. Mai. 2019 10:33 <-- editieren / zitieren --> Unities abgeben:
Hallo! Ich habe folgende Aufgabe zu lösen. Wird derzeit per Hand gemacht, ist aber echt langwierig. Es gibt Polylinien mit Stützpunkten auf Vermessungspunkten. Die Stützpunkte haben natürlich nicht die richtige Z-Koordinate. An den Polylinien hängen noch Objektdaten dran. Diese müssen durch 3DPolylinien ersetzt und die Objektdaten mit copy_od übergeben werden. Ein Lisp wäre natürlich hilfreich aber es zu erstellen zu hoch für mich. Ein Ansatz wäre womöglich: Liste von Polylinien Liste von Objektdaten Liste von X,Y Koordinaten der Vermessungspunkte Neue Stützpunkte generieren = bei identen X,Y auf Z des identen Vermessungspunktes hochziehen 3DPolylinien gemäß Polylinen mit neuem Z erstellen Objektdaten wieder anhängen Vielleicht hat jemand von euch einen anderen Zugang. VD & LG
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 14. Mai. 2019 11:23 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Hallo cadoc, ich würde ja jetzt sagen "gute Idee ... mach das so" Was sind das denn für Daten an der Polylinie ? Ich tippe mal auf erweiterte Elementdaten ? Wie sind denn die Daten aufgebaut ? Was steht denn da drin ? Vielleicht können die Koordinaten direkt verwendet werden. mit vla-Add3DPoly lassen sich 3D-Polylinien sehr einfach erzeugen. ------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 14. Mai. 2019 11:47 <-- editieren / zitieren --> Unities abgeben:
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 14. Mai. 2019 16:36 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
|
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 14. Mai. 2019 16:46 <-- editieren / zitieren --> Unities abgeben:
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 14. Mai. 2019 17:07 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Da weiß ich nicht ob ich helfen kann aber wenn die Daten mal da sind kann ich vielleicht beim Polylinien-erstellen wieder einsteigen. Oder du hängst hier mal ne Beispieldatei mit Daten an und ich schau mal ob ich was lesen kann. ------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de [Diese Nachricht wurde von Andreas Kraus am 14. Mai. 2019 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 14. Mai. 2019 17:24 <-- editieren / zitieren --> Unities abgeben:
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 15. Mai. 2019 08:31 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Da hängen zwar EEDs dran aber so auf den ersten Blick kann ich da nix mit anfangen. Sehen so aus: ("IRD" (1002 . "{") (1000 . "TPMLINK_M1-_-ade") (1070 . 515) (1071 . 1) (1004 . "0100050000000400000002000000000000004C671CBF4F9328404C671CBF4F932840" ) (1002 . "}") ) Unter 1004 steht zwar etwas dass nach "Daten" aussieht aber auch eine Umwandlung in Dezimal oder Binär bringt mich nicht wirklich weiter. Auch in den Dictionaries hab ich erst mal nichts für mich brauchbares gefunden. Wenn das jemand blickt ... bitte melden. ------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 15. Mai. 2019 08:37 <-- editieren / zitieren --> Unities abgeben:
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 15. Mai. 2019 09:00 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
|
joern bosse Ehrenmitglied Dipl.-Ing. Vermessung
Beiträge: 1763 Registriert: 11.10.2004 Window 11 ACAD 2021 CIVIL 2021 BricsCAD ab V14 11th Gen Intel(R) Core(TM) i7-1165G7 @ 2.80GHz 2.80 GHz 32.0GB RAM NVIDIA GeForce MX450<P>
|
erstellt am: 15. Mai. 2019 10:16 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 15. Mai. 2019 10:35 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Neue Idee: Ist es so dass an JEDEM Stützpunkt der Polylinie ein Block "VM" mit dem Einfügepunkt dieses Stützpunktes zu finden ist der Z im Attribut Höhe enthält ? (Evtl. mit etwas Tolleranz in den Nachkommastellen) Dann kann man für jeden Punkt den entsprechenden Block filtern, auslesen und hat die Höhe. Warum hab ich das nicht gleich gesehen ------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 15. Mai. 2019 10:42 <-- editieren / zitieren --> Unities abgeben:
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 15. Mai. 2019 11:32 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Aha. Dann sollte das hier (mal eben schnell hässlich zusammengetippt) helfen. Bei mir funktionierts. Die Daten bekomm ich aber mit meinen Mitteln nicht an die 3D-Polylinie. Bei Fragen zu Lisp ... einfach fragen Code: (defun k_->obj_name (name) ;;; VLA-OBJECT zurückgeben (cond ((= (type name) 'ENAME) (vlax-ename->vla-object name) ) ((= (type name) 'VLA-OBJECT) name ) ((= (type name) 'STRING) (vlax-ename->vla-object (handent name)) ) ((= (type name) 'LIST) (vlax-ename->vla-object (cdr (assoc -1 name))) ) ) )(defun k_satz->entlist (satz) ;;; Elementliste aus Auswahlsatz erstellen (if (= (type satz) 'PICKSET) (vl-remove-if-not '(lambda (dummy) (= (type dummy) 'ENAME)) (mapcar 'cadr (ssnamex satz)) ) ) ) (defun k_get_att (ins name) ;;; Attributinhalt zurückgeben (setq ins (k_->obj_name ins)) (if (and (vlax-property-available-p ins "hasattributes") (= (vla-get-hasattributes ins) :vlax-true) (not (minusp (vlax-safearray-get-u-bound (vlax-variant-value (vla-getattributes ins) ) 1 ) ) ) ) (vla-get-textstring (car (vl-remove-if-not '(lambda (att) (= (vla-get-tagstring att) name)) (vlax-invoke ins 'GetAttributes) ) ) ) ) ) (vl-load-com) (setq ins_list (mapcar 'entget (k_satz->entlist (ssget "x" '((0 . "INSERT") (2 . "VM")))) ) ) (foreach ent_data (mapcar 'entget (k_satz->entlist (ssget '((0 . "LWPOLYLINE")))) ) (setq p_list (mapcar '(lambda (p) (append p (list (atof (k_get_att (cdr (assoc -1 (car (vl-remove-if-not '(lambda (ins) (equal p (k_3d->2d (cdr (assoc 10 ins))) 0.01 ) ) ins_list ) ) ) ) "HOEHE" ) ) ) ) ) (mapcar 'cdr (vl-remove-if-not '(lambda (data) (= (car data) 10)) ent_data ) ) ) ) (setq points (vlax-make-safearray vlax-vbDouble (cons 0 (1- (* (length p_list) 3))) ) ) (vlax-safearray-fill points (apply 'append p_list) ) (setq plineObj (vla-Add3DPoly (vla-get-block (vla-get-activelayout (k_ac-doc))) points ) ) )
------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de [Diese Nachricht wurde von Andreas Kraus am 15. Mai. 2019 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 15. Mai. 2019 12:10 <-- editieren / zitieren --> Unities abgeben:
Also erst mal vielen Dank aber bei mir tut sich da nichts. Das Lisp fragt nach dem Objekt. Klicke Polylinie an - wird aber nicht umgewandelt. Zum Daten dranghängen ist das erwähnte Lisp recht gut. ;;;---------------------------------------------------------------------------; ;;; ;;; COPY_OD.LSP ;;; ;;; (C) Copyright 1998 by Autodesk, Inc. ;;; ;;; Permission to use, copy, modify, and distribute this software ;;; for any purpose and without fee is hereby granted, provided ;;; that the above copyright notice appears in all copies and ;;; that both that copyright notice and the limited warranty and ;;; restricted rights notice below appear in all supporting ;;; documentation. ;;; ;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. ;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF ;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC. ;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE ;;; UNINTERRUPTED OR ERROR FREE. ;;; ;;; Use, duplication, or disclosure by the U.S. Government is subject to ;;; restrictions set forth in FAR 52.227-19 (Commercial Computer ;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) ;;; (Rights in Technical Data and Computer Software), as applicable. ;;; ;;; July 1996 ;;; ;;;---------------------------------------------------------------------------; ;;; ;;; DESCRIPTION ;;; ;;; Copy object data from one object to a set of other objects. If the ;;; object data to be copied already exists on the target object the ;;; options to not copy, copy once and copy all are presented. ;;; ;;; Careful, it is possible to corrupt existing topological data ;;; using this routine. ;;; ;;;---------------------------------------------------------------------------;
;;;**************************************************************************** ;;; Function: C:COPY_OD ;;; ;;; Main routine for copying object data from an object to ;;; a selection set of object. ;;; ;;; (defun C:COPY_OD ( / source_obj ; source object target_obj ; target object target_ss ; target selection set ct ; count len ; length overwrite ; overwrite flag error ; old error function ) (setq error *error*) ;; ;; Define error handler ;; (defun *error* (msg) (alert msg) (setq *error* error) (exit) ) ;; ;; Input the source object to copy data from ;; (princ "\nSelect SOURCE object: ") (setq source_obj (car (entsel))) (if (null source_obj) (prompt "\nNo source object selected.") (progn ;; ;; If the object has object data attached process it ;; (if (null (ade_odgettables source_obj)) (princ "\nSelected object contains no object data.") (progn (princ "\n\nSelect TARGET objects: ") (setq target_ss (ssget)) (if (null target_ss) (prompt "\nNo target object selected.") (progn (setq len (sslength target_ss)) (setq ct 0) (princ "\nCopying object data...") (while (< ct len) (setq target_obj (ssname target_ss ct)) (redraw target_obj 3) (setq ct (+ ct 1)) (setq overwrite (COPY_DATA source_obj target_obj overwrite)) (redraw target_obj 4) ) ) );if ) );if ) );if (setq *error* error) ;restore error handler (prompt "\nProcessing completed.") (princ) );C:COPY_OD ;;;**************************************************************************** ;;; Function: C:COPY_DATA ;;; ;;; Copy object data from the source object to the target object. ;;; ;;; If the data is already found to exist on a target object, the ;;; user is prompted what to do. Either to replace it only on the ;;; target, for all objects in the selection set, or to skip it. ;;; ;;; (defun COPY_DATA ( source_obj target_obj overwrite ; overwrite flag / ct ct2 cttemp fld fldnme fldnamelist fldtyp fldtypelist len numrec OK tbl tbllist tbldef tblstr val vallist ) ;; ;; access all OD tables from source object ;; (if (setq tbllist (ade_odgettables source_obj)) (progn ;; ;; for each table on source object ;; (foreach tbl tbllist (prompt (strcat "\nProcessing source table " tbl ".")) ;; ;; determine if target object has object ;; data records for current table ;; (setq OK nil) (setq numrec (ade_odrecordqty target_obj tbl)) ;; ;; If the table is found on object ask what to do ;; (if (and (> numrec 0) (/= overwrite "All")) (progn (initget "All Yes No") (setq overwrite (getkword "\nOverwrite existing record(s) on target? (All/Yes/No) <All>: ")) (if (null overwrite) (setq overwrite "All") ) ) ) (if (or (= overwrite "All") (= overwrite "Yes") (= numrec 0) ) (setq OK T) ) ;; ;; delete all existing records on target ;; object if overwrite flag is set ;; (if (and (> numrec 0) (or (= overwrite "Yes")(= overwrite "All")) ) (progn (setq ct 0) (while (< ct numrec) (ade_oddelrecord target_obj tbl ct) (setq ct (+ ct 1)) ) ) ) (if OK (progn ;; ;; build list of field names ;; (setq tbldef (ade_odtabledefn tbl)) (setq tblstr (cdr (nth 2 tbldef))) (setq fldnamelist ()) (setq fldtypelist ()) (foreach fld tblstr (setq fldnme (cdr (nth 0 fld))) (setq fldtyp (cdr (nth 2 fld))) (setq fldnamelist (append fldnamelist (list fldnme))) (setq fldtypelist (append fldtypelist (list fldtyp))) ) ;; ;; for each record on source object ;; (setq numrec (ade_odrecordqty source_obj tbl)) (setq ct 0) (while (< ct numrec) ;; ;; build list of values ;; (setq cttemp 0) (setq vallist ()) (foreach fld fldnamelist (setq typ (nth cttemp fldtypelist)) (setq cttemp (+ cttemp 1)) (setq val (ade_odgetfield source_obj tbl fld ct)) (if (= typ "Integer")(setq val (fix val))) (setq vallist (append vallist (list val))) ) ;; ;; add a record to target object ;; (ade_odaddrecord target_obj tbl) ;; ;; populate target record with values from source record ;; (setq ct2 0) (while (< ct2 (length vallist)) (setq val (nth ct2 vallist)) (setq fld (nth ct2 fldnamelist)) (setq ct2 (+ ct2 1)) (ade_odsetfield target_obj tbl fld ct val) ) (setq ct (+ ct 1)) );while ) );if );foreach ) );if ;; ;; Return overwrite status so it can ;; be passed back in for the next object. ;; overwrite );COPY_DATA (prompt "\nType: COPY_OD to copy object data.") (princ)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 15. Mai. 2019 15:00 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Gibts irgendeine Fehlermeldung ? Ich hab vielleicht eine Funktion vergessen zu kopieren. Die hier fehlt noch hab ich grade gesehen. Code: (defun k_ac-doc () (vla-get-activedocument (vlax-get-acad-object)) )
------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 16. Mai. 2019 08:01 <-- editieren / zitieren --> Unities abgeben:
|
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 16. Mai. 2019 08:37 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Ich bin aber auch ein Schussel Code: (defun k_3d->2d (wert / dummy) (if (vl-every '(lambda (dummy) (= (type dummy) 'LIST)) wert) (mapcar '(lambda (dummy) (list (car dummy) (cadr dummy))) wert ) (list (car wert) (cadr wert)) ) )
------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 16. Mai. 2019 08:58 <-- editieren / zitieren --> Unities abgeben:
WOW - Also es funktioniert schon mal. Wo es noch nicht funzt ist: Objekte wählen: 1 gefunden Objekte wählen: 1 gefunden, 2 gesamt Objekte wählen: 1 gefunden, 3 gesamt Objekte wählen: ; Fehler: Überzählige rechte Klammer in Eingabe Er zeichnet nur die letzte hoch. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andreas Kraus Mitglied Elektrotechniker
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 16. Mai. 2019 09:56 <-- editieren / zitieren --> Unities abgeben: Nur für cadoc
Hm, komisch. Ich stells hier nochmal komplett rein. Bei mir funktionierts. Den Namen der Funktion kannst du ja ändern wie du willst. [CODE][ (defun c oly->3d-poly (/ DUMMY INS_LIST P PLINEOBJ POINTS P_LIST) (defun k_ac-doc () (vla-get-activedocument (vlax-get-acad-object)) ) (defun k_3d->2d (wert / dummy) (if (vl-every '(lambda (dummy) (= (type dummy) 'LIST)) wert) (mapcar '(lambda (dummy) (list (car dummy) (cadr dummy))) wert ) (list (car wert) (cadr wert)) ) ) (defun k_->obj_name (name) ;;; VLA-OBJECT zurückgeben (cond ((= (type name) 'ENAME) (vlax-ename->vla-object name) ) ((= (type name) 'VLA-OBJECT) name ) ((= (type name) 'STRING) (vlax-ename->vla-object (handent name)) ) ((= (type name) 'LIST) (vlax-ename->vla-object (cdr (assoc -1 name))) ) ) ) (defun k_satz->entlist (satz) ;;; Elementliste aus Auswahlsatz erstellen (if (= (type satz) 'PICKSET) (vl-remove-if-not '(lambda (dummy) (= (type dummy) 'ENAME)) (mapcar 'cadr (ssnamex satz)) ) ) ) (defun k_get_att (ins name) ;;; Attributinhalt zurückgeben (setq ins (k_->obj_name ins)) (if (and (vlax-property-available-p ins "hasattributes") (= (vla-get-hasattributes ins) :vlax-true) (not (minusp (vlax-safearray-get-u-bound (vlax-variant-value (vla-getattributes ins) ) 1 ) ) ) ) (vla-get-textstring (car (vl-remove-if-not '(lambda (att) (= (vla-get-tagstring att) name)) (vlax-invoke ins 'GetAttributes) ) ) ) ) ) (vl-load-com) (setq ins_list (mapcar 'entget (k_satz->entlist (ssget "x" '((0 . "INSERT") (2 . "VM")))) ) ) (foreach ent_data (mapcar 'entget (k_satz->entlist (ssget '((0 . "LWPOLYLINE")))) ) (setq p_list (mapcar '(lambda (p) (append p (list (atof (k_get_att (cdr (assoc -1 (car (vl-remove-if-not '(lambda (ins) (equal p (k_3d->2d (cdr (assoc 10 ins))) 0.01 ) ) ins_list ) ) ) ) "HOEHE" ) ) ) ) ) (mapcar 'cdr (vl-remove-if-not '(lambda (data) (= (car data) 10)) ent_data ) ) ) ) (setq points (vlax-make-safearray vlax-vbDouble (cons 0 (1- (* (length p_list) 3))) ) ) (vlax-safearray-fill points (apply 'append p_list) ) (setq plineObj (vla-Add3DPoly (vla-get-block (vla-get-activelayout (k_ac-doc))) points ) ) ) (princ) ) /CODE] Edit: Hab grade gesehen dass in der Zeile wo der Programmcode zuende ist noch die letzte Klammer steht. Vielleicht hast du die nicht mitkopiert. Ich habs hier mal geändert. ------------------ Geht nicht, gibts nicht Gruß Andreas http://kraus-cad.de [Diese Nachricht wurde von Andreas Kraus am 16. Mai. 2019 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadoc Mitglied
Beiträge: 28 Registriert: 23.08.2018
|
erstellt am: 16. Mai. 2019 10:21 <-- editieren / zitieren --> Unities abgeben:
|