Maß als Text ausgeben

Was für ein Lisp-Tool sucht ihr? Oder welches Problem bedarf einer Lösung?

Moderator: Moderator

Antworten
Hämmy
Newbie
Beiträge: 5
Registriert: Mi 29. Aug 2018, 15:47

Maß als Text ausgeben

Beitrag von Hämmy » Mi 12. Sep 2018, 09:16

Hallo Leute,

ich habe des Öfteren gezeichnete Objekte von denen ich die Länge und Breite in das Objekt als Text rein schreibe.
Ich habe bis jetzt immer getrickst, und bei meiner Bemaßungslinie alles raus genommen außer den Text mit dem Maß, dann bei der zweiten Bemaßungslinie das selbe, und die beiden Maße hintereinander gestellt (das Vertikale Maß noch um 90° gedreht).
So hatte ich in meinen Objekt Länge x Breite stehen, sobald ich dieses noch einmal strecken musste, haben sich die Maße mit geändert.

Leider ist das immer sehr Aufwendig, daher hier meine Frage ob man das nicht mit einen Tool oder ähnlichen hinbekommen könnte.

Ich freue mich auf Anregungen und eventuelle Lösungen von Euch.

Gruß Stefan

Benutzeravatar
CADwiesel
Administrator
Beiträge: 358
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Re: Maß als Text ausgeben

Beitrag von CADwiesel » Mo 17. Sep 2018, 10:21

Naja grundsätzlich ist es unter bestimmten Umständen möglich die Maße in den Grenzen des Objektes darzustellen. Über die Methode BoundingBox ist es Möglich die max X-Y Ausdehnung zu ermitteln. Die Frage ist aber eher wie diese Objekte aussehen, die Erstellt werden. Sind das Rechtecke, Kreise oder eher Polylinienzüge die z.b eine Raumgrenze darstellen?
Einfach mal einige Beispiele hier anhängen und dann schaun ma mal...
Gruß
BildCADwiesel
Besucht uns im CHAT

Hämmy
Newbie
Beiträge: 5
Registriert: Mi 29. Aug 2018, 15:47

Re: Maß als Text ausgeben

Beitrag von Hämmy » Mo 17. Sep 2018, 10:36

Danke für die Antwort,

wenn ich das machen möchte, dann nur Breite x Länge.
Ich muß viele Fenster Türen und Pfosten-Riegel Fassaden zeichnen, dort sind dann immer in den Vertikalen und Horizontalen Schnitten die Breite x Länge in den Objekten, nur sobald ich diese noch einmal strecke, muß ich jedesmal den text ändern.
bzw. wenn ich es vergesse, kann es sein das unsere AV falsche fertigen lässt.

Ich hänge einmal Beispiele an

Gruß Stefan
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.

Benutzeravatar
CADwiesel
Administrator
Beiträge: 358
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Re: Maß als Text ausgeben

Beitrag von CADwiesel » Mo 17. Sep 2018, 17:02

Ich habe mal für die Blockreferenzen ein kleines Tool gemacht. Es wird die X und Y Ausdehnung der ausgewählten Blockref ermittelt und dann ein MText in dem Mittelpunkt plaziert.
Der Text besteht aus 2 Feldern, die den X- und Y- Skalierungsfaktor des Inserts mit der X- und Y- Ausdehnung des Inserts multipliziert.
Wird nun das Insert über seine X oder y Werte skaliert weden die Felder neu berechnet.
Die Zeichnung muss aktualisiert werden, damit die Werte sichtbar werden.

Code: Alles auswählen

(defun c:bembox (/ obj LU RO CENTER XWERT YWERT TObj)
  
  (defun field-makeObjectRefText (#object #property1 #property2 prefix suffix /)
    (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
            (itoa (vla-get-ObjectID #object))
            ">%)."
            (vl-princ-to-string #property1)
            " \\f \"%lu2%pr0%ct8["
            prefix
            "]\">%"
            "x"
            "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
            (itoa (vla-get-ObjectID #object))
            ">%)."
            (vl-princ-to-string #property2)
            " \\f \"%lu2%pr0%ct8["
            suffix
            "]\">%"
            ) ;_ end of strcat
  ) ;_ end of defun
  
  
  (if (and
        (setq obj (car (entsel)))
        (= (cdr (assoc 0 (entget obj))) "INSERT")
        (not (vl-catch-all-error-p
               (vl-catch-all-apply
                 'vla-getboundingbox
                 (list (vlax-ename->vla-object obj) 'LU 'RO)
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
        (setq LU (vlax-safearray->list LU))
        (setq RO (vlax-safearray->list RO))
        (setq CENTER (mapcar '/ (mapcar '+ LU RO) '(2.0 2.0 2.0)))
        (setq XWERT (rtos (distance LU (list (car RO) (cadr LU)))2 0))
        (setq YWERT (rtos (distance LU (list (car LU) (cadr RO)))2 0))
        
        (setq TObj (vla-addText
                     (if (= 1 (getvar 'cvport))
                       (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                       (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                     )
                     (strcat  XWERT "x" YWERT)
                     (vlax-3d-point (trans CENTER 1 0))
                     10
                   )
        )
      )
    (progn
      (vl-catch-all-apply
        'vlax-put
        (list TObj
              'Alignment
              10
        ) ;_ end of list
      )
      (vl-catch-all-apply
        'vla-put-TextAlignmentPoint
        (list TObj
              (vlax-3d-point (trans CENTER 1 0))
        )
      )
      (vl-catch-all-apply 'vla-put-Layer (list TObj "002-Bemaßung a"))
      
      (entmod
                       (subst (cons 1
                                    (field-makeObjectRefText
                                      (vlax-ename->vla-object obj)
                                      'XEffectiveScaleFactor
                                      'YEffectiveScaleFactor
                                      XWERT
                                      YWERT
                                      ) ;_ end of field-makeObjectRefText
                                    ) ;_ end of cons
                              (assoc 1 (entget (vlax-vla-object->ename TObj)))
                              (entget (vlax-vla-object->ename TObj))
                              ) ;_ end of subst
                       )
    )
  )
)
Gruß
BildCADwiesel
Besucht uns im CHAT

Hämmy
Newbie
Beiträge: 5
Registriert: Mi 29. Aug 2018, 15:47

Re: Maß als Text ausgeben

Beitrag von Hämmy » Di 18. Sep 2018, 06:37

@CADwiesel,

damit klappt es bei mir leider nicht so richtig ;)
das geht dann nur bei einen Block, und bei geschlossenen Polylinien nicht oder?
Denn ich muss das Textfeld auch in geschlossen Polylinien einfügen, und eventuell noch einen Text wie die Holzart mit anhängen.
Sobald ich die Breite oder Höhe der Polylinie verändere, muss der Text sich auch anpassen.

Bei einen Block kommt bei mir im Moment ein langer Text:
%<\AcObjProp.16.2 Object(%<\_ObjId 674596976>%).XEFFECTIVESCALEFACTOR \f "%lu2%pr0%ct8[90]">%x%<\AcObjProp.16.2 Object(%<\_ObjId 674596976>%).YEFFECTIVESCALEFACTOR \f "%lu2%pr0%ct8[87]">%

Einmal war der Text weg und es stand das Maß drin, aber dann hat er die komplette breite genommen, einschließlich aller Objekte die im Block sind.

Gruß Stefan

Benutzeravatar
CADwiesel
Administrator
Beiträge: 358
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Re: Maß als Text ausgeben

Beitrag von CADwiesel » Mi 19. Sep 2018, 13:14

Hier mal eine Version für AutoCAD. unter BricsCAD funktioniert das so noch nicht.
Im speziellen wird die Polylinie auf dem Layer 015-Holzteile ausgewertet, wenn es sich um ein INSERT handelt.
Handelt es sich um eine Polylinie oder Linie, wird nach dem ersten Auswahlklick der Anwender aufgefordert 4 Punkte (je 2 in x-Richtung und 2 in y-Richtung) zu klicken. Es wird dann je eine Bemassung in x und y Richtung erstellt und deren Werte werden in einem MText, der Mittig im Objekt liegt, eingetragen.
Um das Ganze für BricsCAD nutzbar zu machen, müssen Änderungen vorgenommen werden.

Code: Alles auswählen

(defun c:bembox (/ obj LU RO CENTER XWERT YWERT TObj)

  (defun field-makeObjectRefText (#object1 #object2 #property1 #property2 prefix suffix /)
    (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
            (itoa (vla-get-ObjectID #object1))
            ">%)."
            (vl-princ-to-string #property1)
            (if prefix (strcat " \\f \"%lu2%pr0%ct8[" prefix "]\">%") (strcat " \\f \"%lu2%pr0\">%"))
            "x"
            "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
            (itoa (vla-get-ObjectID #object2))
            ">%)."
            (vl-princ-to-string #property2)
            (if suffix (strcat " \\f \"%lu2%pr0%ct8[" suffix "]\">%") (strcat " \\f \"%lu2%pr0\">%"))
    ) ;_ end of strcat
  ) ;_ end of defun


  (defun Legende_expl_insert
    (elem / OBJ OBJS ROTOBJS LU RO BOUNDINGLAYER)

    (setq BOUNDINGLAYER '( "015-Holzteile"))
    (setq
      OBJS (Legende_explode_blk elem)
    ) ;_ end of setq
    (setq ROTOBJS
          (vl-remove 'nil
                     (mapcar
                       '(lambda (X / LU RO)
                          (cond
                            ((= (strcase (vla-get-objectname x))
                                "ACDBBLOCKREFERENCE"
                             ) ;_ end of =
                              (Legende_expl_insert x)
                            )
                            ((and
                               (not
                                 (member (strcase (vla-get-objectname x))
                                         '( "ACDBTEXT"
                                            "ACDBMTEXT"
                                            "ACDBATTRIBUTEDEFINITION"
                                          )
                                 ) ;_ end of =
                               ) ;_ end of not
                               (member (strcase (vla-get-layer X))
                                       (mapcar 'strcase BOUNDINGLAYER)
                               ) ;_ end of member
                               (not (vl-catch-all-error-p
                                      (vl-catch-all-apply
                                        'vla-getboundingbox
                                        (list X 'LU 'RO)
                                      ) ;_ end of vl-catch-all-apply
                                    ) ;_ end of vl-catch-all-error-p
                               ) ;_ end of not
                             ) ;_ end of and
                              (progn
                                (setq LU (vlax-safearray->list LU))
                                (setq RO (vlax-safearray->list RO))
                                (list LU RO)
                              ) ;_ end of progn
                            ) ;_ end of if
                          ) ;_ end of cond
                        ) ;_ end of lambda
                       OBJS  ;(list INSERT);
                     ) ;_ end of mapcar
          ) ;_ end of vl-remove
    ) ;_ end of setq
    (foreach OBJ OBJS
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               'vla-delete
               (list OBJ)
             ) ;_ end of vl-catch-all-apply
           ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    ) ;_ end of foreach
    (apply 'append ROTOBJS)
  )


  (defun Legende_explode_blk
    (blk / blnm TMP_blk adoc blk1 elist ents lastent)

    (if (eq (type blk) 'ENAME)
      (setq blk1 (vlax-ename->vla-object blk))
      (setq blk1 blk
            blk (vlax-vla-object->ename blk)
      ) ;_ end of setq
    ) ;_ end of if
    (setq blnm (vla-item
                 (vla-get-blocks
                   (vla-get-activedocument (vlax-get-acad-object))
                 ) ;_ end of vla-get-blocks
                 (vla-get-EffectiveName blk1)
               ) ;_ end of vla-item
    ) ;_ end of setq
    (if (= (vla-get-explodable blnm) :vlax-false)
      (progn
        (vl-catch-all-apply
          'vla-put-explodable
          (list blnm :vlax-true)
        ) ;_ end of vl-catch-all-apply
        (vla-update blk1)
        (vla-regen (vla-get-activedocument (vlax-get-acad-object))
                   acAllViewports
        ) ;_ end of vla-regen
      ) ;_ end of progn
    ) ;_ end of if
    (if
      (vl-catch-all-error-p
        (vl-catch-all-apply
          '(lambda ()
                   (setq ents (vlax-invoke blk1 'explode))
           ) ;_ end of lambda
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vl-catch-all-error-p
      (progn
        (setq TMP_blk (vla-copy blk1))
        (setq lastent (entlast)
              ents nil
        ) ;_ end of setq
        (vl-catch-all-error-p
          (vl-catch-all-apply
            'vl-cmdf
            (list "_.explode"
                  (vlax-vla-object->ename TMP_blk)
                  ""
            ) ;_ end of list
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of vl-catch-all-error-p
        (while (setq lastent (entnext lastent))
          (setq ents (cons lastent ents))
        ) ;_ end of while
        (if (vlax-vla-object->ename TMP_blk)
          (vl-catch-all-apply 'vla-delete (list TMP_blk))
        ) ;_ end of if
        (setq ents (mapcar 'vlax-ename->vla-object ents))
      ) ;_ end of progn
    ) ;_ end of if
    ents
  )


  (defun Legende_get_mitte (belems / ROTOBJS LU RO CENTER)
    (if (setq ROTOBJS (Legende_expl_insert belems))
      (progn
        (setq LU
              (list
                (apply 'min (mapcar '(lambda (X) (car x)) ROTOBJS))
                (apply 'min (mapcar '(lambda (X) (cadr x)) ROTOBJS))
              ) ;_ end of list
        ) ;_ end of setq
        (setq RO
              (list
                (apply 'max (mapcar '(lambda (X) (car x)) ROTOBJS))
                (apply 'max (mapcar '(lambda (X) (cadr x)) ROTOBJS))
              ) ;_ end of list
        ) ;_ end of setq
        (setq CENTER (mapcar '/ (mapcar '+ LU RO) '(2.0 2.0 2.0)))
        (list LU RO Center)
      ) ;_ end of progn
      (progn
        (not (vl-catch-all-error-p
               (vl-catch-all-apply
                 'vla-getboundingbox
                 (list belems 'LU 'RO)
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
        (setq LU (vlax-safearray->list LU))
        (setq RO (vlax-safearray->list RO))
        (list LU RO)
        (setq CENTER (mapcar '/ (mapcar '+ LU RO) '(2.0 2.0 2.0)))
        (list LU RO Center)
      ) ;_ end of progn
    ) ;_ end of if
  )


  (if (and
        (setq obj (car (entsel)))
        (= (cdr (assoc 0 (entget obj))) "INSERT")
        (not (vl-catch-all-error-p
               (vl-catch-all-apply
                 'vla-getboundingbox
                 (list (vlax-ename->vla-object obj) 'LU 'RO)
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
        (setq LU (vlax-safearray->list LU))
        (setq RO (vlax-safearray->list RO))
        (setq CENTER (mapcar '/ (mapcar '+ LU RO) '(2.0 2.0 2.0)))
        (setq XWERT (rtos (distance LU (list (car RO) (cadr LU))) 2 0))
        (setq YWERT (rtos (distance LU (list (car LU) (cadr RO))) 2 0))
        (setq TObj (vla-addText
                     (if (= 1 (getvar 'cvport))
                       (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                       (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                     )
                     (strcat XWERT "x" YWERT)
                     (vlax-3d-point (trans CENTER 1 0))
                     10
                   )
        )
      )
    (progn
      (vl-catch-all-apply
        'vlax-put
        (list TObj
              'Alignment
              10
        ) ;_ end of list
      )
      (vl-catch-all-apply
        'vla-put-TextAlignmentPoint
        (list TObj
              (vlax-3d-point (trans CENTER 1 0))
        )
      )
      (vl-catch-all-apply 'vla-put-Layer (list TObj "002-Bemaßung a"))
      (entmod
        (subst (cons 1
                     (field-makeObjectRefText
                       (vlax-ename->vla-object obj)
                       (vlax-ename->vla-object obj)
                       'XEffectiveScaleFactor
                       'YEffectiveScaleFactor
                       XWERT
                       YWERT
                     ) ;_ end of field-makeObjectRefText
               ) ;_ end of cons
          (assoc 1 (entget (vlax-vla-object->ename TObj)))
          (entget (vlax-vla-object->ename TObj))
        ) ;_ end of subst
      )
    )
    (if
      (and
        (setq dimpt1 (nentselp "Ersten Bemassungspunkt in X-Richtung zeigen: "))
        (setq dimpt2 (nentselp "\nZweiten Bemassungspunkt in X-Richtung zeigen: "))
        (setq dimpt3 (nentselp "\nErsten Bemassungspunkt in Y-Richtung zeigen: "))
        (setq dimpt4 (nentselp "\nZweiten Bemassungspunkt in Y-Richtung zeigen: "))
        (setq dimpt1 (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car dimpt1)) (last dimpt1)))
        (setq dimpt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car dimpt2)) (last dimpt2)))
        (setq dimpt3 (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car dimpt3)) (last dimpt3)))
        (setq dimpt4 (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car dimpt4)) (last dimpt4)))
        (setq mitte1 (mapcar '/ (mapcar '+ dimpt1 dimpt2) '(2.0 2.0 2.0)))
        (setq mitte2 (mapcar '/ (mapcar '+ dimpt3 dimpt4) '(2.0 2.0 2.0)))
        (command "_dimlinear" dimpt1 dimpt2 mitte1)
        (setq dim1 (entlast))
        (command "_dimlinear" dimpt3 dimpt4 mitte2)
        (setq dim2 (entlast))
      )
      (progn
        (vl-catch-all-apply 'vla-put-DimLine1Suppress (list (vlax-ename->vla-object dim1) -1))
        (vl-catch-all-apply 'vla-put-DimLine2Suppress (list (vlax-ename->vla-object dim1) -1))
        (vl-catch-all-apply 'vla-put-DimLine1Suppress (list (vlax-ename->vla-object dim2) -1))
        (vl-catch-all-apply 'vla-put-DimLine2Suppress (list (vlax-ename->vla-object dim2) -1))
        (vl-catch-all-apply 'vla-put-arrowheadsize (list (vlax-ename->vla-object dim1) 0))
        (vl-catch-all-apply 'vla-put-TextHeight (list (vlax-ename->vla-object dim1) 0.00001))
        (vl-catch-all-apply 'vla-put-ExtLine1Suppress (list (vlax-ename->vla-object dim1) -1))
        (vl-catch-all-apply 'vla-put-ExtLine2Suppress (list (vlax-ename->vla-object dim1) -1))
        (vl-catch-all-apply 'vla-put-ExtLine1Suppress (list (vlax-ename->vla-object dim2) -1))
        (vl-catch-all-apply 'vla-put-ExtLine2Suppress (list (vlax-ename->vla-object dim2) -1))
        (vl-catch-all-apply 'vla-put-arrowheadsize (list (vlax-ename->vla-object dim2) 0))
        (vl-catch-all-apply 'vla-put-TextHeight (list (vlax-ename->vla-object dim2) 0.00001))
        (setq CENTER (mapcar '/ (mapcar '+ mitte1 mitte2) '(2.0 2.0 2.0)))
        (setq TObj (vla-addText
                     (if (= 1 (getvar 'cvport))
                       (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                       (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                     )
                     "x"
                     (vlax-3d-point (trans CENTER 1 0))
                     10
                   )
        )
        (vl-catch-all-apply
          'vlax-put
          (list TObj
                'Alignment
                10
          ) ;_ end of list
        )
        (vl-catch-all-apply
          'vla-put-TextAlignmentPoint
          (list TObj
                (vlax-3d-point (trans CENTER 1 0))
          )
        )
        (entmod
          (subst (cons 1
                       (field-makeObjectRefText
                         (vlax-ename->vla-object dim1)
                         (vlax-ename->vla-object dim2)
                         'Measurement
                         'Measurement
                         nil; ""  ;XWERT
                         nil; ""  ;YWERT
                       )
                 ) ;_ end of cons
            (assoc 1 (entget (vlax-vla-object->ename TObj)))
            (entget (vlax-vla-object->ename TObj))
          ) ;_ end of subst
        )
      )
    )
  )
  (vla-regen
    (vla-get-activedocument
      (vlax-get-acad-object)
      )
    acAllViewports
    )
    (princ)
)
Gruß
BildCADwiesel
Besucht uns im CHAT

Hämmy
Newbie
Beiträge: 5
Registriert: Mi 29. Aug 2018, 15:47

Re: Maß als Text ausgeben

Beitrag von Hämmy » Do 20. Sep 2018, 07:24

ich habe das jetzt einmal getestet, wenn ich ein Rechteck habe und starte bembox, kommt folgendes:

-Objekt auswählen
-Ersten Bemassungspunkt in X-Richtung zeigen
-Zweiten Bemassungspunkt in X-Richtung zeigen
-Ersten Bemassungspunkt in Y-Richtung zeigen
-Zweiten Bemassungspunkt in Y-Richtung zeigen

Danach setzt er eine Bemassungslinie mit Maß für das X-X Maß ein, für Y-Y nicht

Schade hatte mich schon gefreut das mir die Arbeit in Zukunft erleichtert wird, aber scheint doch schwierig zu sein, das so hinzubekommen.
Wenn es für AutoCAD ist, sollte es laufen.

Gruß Stefan

Hämmy
Newbie
Beiträge: 5
Registriert: Mi 29. Aug 2018, 15:47

Re: Maß als Text ausgeben

Beitrag von Hämmy » Do 4. Okt 2018, 08:40

ich wollte noch einmal nachfragen ob wir eine Lösung erarbeiten können, oder geht es nicht?

Danke für die Mühe

Gruß Stefan

Antworten