Applications for Object Data

[АлексЮстасу]

I suggest to collect free programs for Object Data.

And to discuss them.

For example, Autodesk, Copy object data from one object to a set of other objects - COPY_OD.LSP.
Contained in C:\Program Files\Autodesk\AutoCAD...\Sample

Autodesk (?), XD to OD conversions - XD2OD.lsp.

For example, braudpat published lisp to select objects by OD values - Sel_by_OD.lsp.
https://forums.autodesk.com/t5/autocad-map-3d-forum/object-data-how-to-use-the-find-command/m-

p/5445541#M43818

For example, CADaSchtroumpf published lisp for conversion from OD to XD - OD2XD.lsp.
https://forums.autodesk.com/t5/autocad-map-3d-forum/map-3d-od-to-autocad-dwg/m-p/9329382#M56358

In the text of this lisp you must specify the author and his data for the link.

[braudpat]

Hello @franc_as & @АлексЮстасу 

Please test this routine : Sel_By_OD

This is Version 2.02 of the Routine

The Micro-Bug on OD String Field with the Test DIFFERENT has been solved !

THE HEALTH, Bye, Patrice

[franc_as]

Hi
Thank you, it is Ok now.
I made a little modification by adding a line at the end, to zoom at selection,...

(princ (strcat "\n" (itoa (sslength js_sel)) " found "))
(sssetfirst nil js_sel)
(command "zoom" "o") ; this makes zoom

(prin1)
)

Unfortunately, after this, objects selection is lost.
I would like to add selection of searching result object again, but I cant make it.
Could you help me?

And just one thing. I found out, that if selected object at the beginning of command is block, then this command dont work.
Result is 0.

[braudpat]

Hello @АлексЮстасу 

Yet an other beautiful routine from Bruno = CADaSchtroumpf !

Converting 2D LWPoly to 3D Poly keeping ALL Infos : XDatas, ODs, etc ...

The Health, Bye, Patrice

[АлексЮстасу]

Hi, Patrice,

Will this program work in the base AutoCAD (for XData)?
I can't check right now.

[braudpat]

Hello Alexander

In theory, YES but I can't test !

;;
;; This function works (normally) also on a classic AutoCAD for XData
;; if you don't have Map or Civil (of course the OD will not be processed)
;;

The Health, Bye, Patrice

[АлексЮстасу]

Hello, Patrice,

So, CADaSchtroumpf again made a useful program that better takes into account, saves additional data!

🙂

[braudpat]

Hello

Here is the version 1.1 of the beautiful Lisp routine "LWto3DPoly" by CADaSchtroumpf !

Now the 3D PLines created are keeping properties from the original 2D Plines (LWPOLYLINE) :

color, linetype, width, etc

The Health, Bye, Patrice

[franc_as]

I found out that there is problem if objects are differend types. If I select circle at start, it could find OD data value onyl on cirlcles. If polyline or mpolygon for instance
contains searhing value, result is 0. Can you fix that?

[braudpat]

OLD BAD message - Please look at Message #88 for the NEW Version 2.02 of Sel_By_OD

[franc_as]

Thank you

I am testing this version and must tell that it is works fine, as you explained.
The only thing I would like to add is zoom to selection.
I don't know much about creating lisps, but anyway, I am trying to modify lisp by adding command line for
zoom to selection at the end..... (command "zoom" "o")
so the end looks like this:

(sssetfirst nil js_sel)
(command "zoom" "o") ; this makes zoom

(prin1)
)

It works. but unforunatelly I've lost selection after this modification.

Do you have any Idea where to put this line or something similar?

[АлексЮстасу]

Hi, Patrice,

Good program improvement.

Is my offer of 60 too difficult to implement:

"It would be good for >, < to also work for Character data."?

[O_Eckmann]

Hi,

Just invert 2 lines

(command "_zoom" "_o" js_sel "") ; this makes zoom
(sssetfirst nil js_sel)
(prin1)
)

Olivier

[franc_as]

 It works... as I want to do.
Thank you very much.... and also to braudpat and CADaSchtroumpf!

[paliwal222]

I want to select multiple text in one time.

[braudpat]

Hello

Please explain ?

Is it related to Object Data ?

The Health, Bye, Patrice 

[АлексЮстасу]

You can select many texts and many primitives with OD at once, and for all these texts their content will be loaded into one OD field.
A tool that loads the contents of many texts into many OD fields does not yet exist.
There is such a tool for attributes - but for them you need to create a match file of attribute names to OD field names.

[paliwal222]

Sir,

from given list, i found a file "multi-OD2Label_Side"

it useful but i want to select multiple OD in one time.

I have od more than 15 nos.

And i have to need to feed 5 lebels.

for that I have to give command  "multi-OD2Label_Side" 5 times.

I want to done it in one time.

[paliwal222]

Dear, Bruno

Sir,

from given links list, I found a file "multi-OD2Label_Side"

It is useful, but I want to select multiple OD in one time. ( it is mark 1 lebel in 1 time and I have to give command more time to mark more lebel.)

I have OD more than 15 nos.

And I have need to feed 5 lebels.

for that I have to give command  "multi-OD2Label_Side" 5 times.

I want to done it in one time.

It is apply on polyline only, does it is possible to select text object also.

[CADaSchtroumpf]

Hi,

For try whitout guaranted...

Minimalist tested.

(vl-load-com)
(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons
      (substr str 1 pos)
      (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)
(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
  (setq
    tmp (vl-filename-mktemp "tmp.dcl")
    file (open tmp "w")
  )
  (write-line
    (strcat "ListBox:dialog{label=\"" title "\";")
    file
  )
  (if (and msg (/= msg ""))
    (write-line (strcat ":text{label=\"" msg "\";}") file)
  )
  (write-line
    (cond
      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
      ((= 1 flag) "spacer;:list_box{key=\"lst\";")
      (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
    )
    file
  )
  (write-line "}ok_cancel_err;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "ListBox" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list (mapcar 'cdr keylab))
  (end_list)
  (action_tile
    "accept"
    "(or (= (get_tile \"lst\") \"\")
      (if (= 2 flag)
        (progn
          (foreach n (str2lst (get_tile \"lst\") \" \")
            (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
          )
          (setq choice (reverse choice))
        )
        (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
      )
    )
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  choice
)
(defun c:OD2Label_Side ( / js ename htx AcDoc Space nw_style lst_tabl_def inc_key lst_def desc_od desc_tbl str msg pt deriv rtx nw_obj)
(setq lst_def nil)
  (princ "\nSélectionnez une polyligne.")
  (while
    (null
      (setq js
        (ssget
          (list
            '(0 . "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE,*TEXT,INSERT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nCe n'est pas un objet valable pour cette fonction!")
  )
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (cond
    ((null (tblsearch "LAYER" "Label"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "Arial-Label"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Arial-Label"))
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_style pr val)
        )
        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
        (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
      )
    )
  )
  (repeat (setq n (sslength js))
    (setq ename (ssname js (setq n (1- n))))
    (if (member (cdr (assoc 0 (entget ename))) '("INSERT" "TEXT" "MTEXT"))
      (setq pt (cdr (assoc 10 (entget ename))) rtx (cdr (assoc 50 (entget ename))))
      (setq
        pt (vlax-curve-getPointAtDist ename (* 0.5 (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename))))
        deriv (vlax-curve-getFirstDeriv ename (vlax-curve-GetParamAtPoint ename pt))
        rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
      )
    )
    (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
    (cond
      ((ade_odgettables ename)
        (if (not htx)
          (progn
            (initget 6)
            (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
            (if htx (setvar "TEXTSIZE" htx) (setq htx (getvar "TEXTSIZE")))
          )
        )
        (setq lst_tabl_def (mapcar 'ade_odtabledefn (ade_odgettables ename)) inc_key 0)
        (foreach n lst_tabl_def
          (foreach el n
            (if (listp (cdr el))
              (foreach sel (cdr el)
                (foreach msel sel
                  (if (eq (car msel) "ColName")
                    (setq lst_def (cons (cdr msel) lst_def))
                  )
                )
              )
            )
          )
        )
        (if (not desc_od)
          (setq desc_od (listbox "Donnée d'objet" "Choisir des données d'objet" (mapcar 'cons lst_def lst_def) 2) desc_tbl nil)
        )
        (foreach n lst_tabl_def
          (foreach i desc_od
            (if (assoc (cons "ColName" i) (cdaddr n))
              (setq desc_tbl (cons (cdar n) desc_tbl))
            )
          )
        )
        (cond
          (desc_tbl
            (setq
              str
              (apply 'strcat
                (mapcar
                  '(lambda (x y / w)
                    (setq w (ade_odgetfield ename x y 0))
                    (strcat
                      (cond
                        ((eq (type w) 'INT) (itoa w))
                        ((eq (type w) 'REAL) (rtos w 2 2))
                        ((eq (type w) 'STR) w)
                        (T "")
                      )
                      "\\P"
                    )
                  )
                  desc_tbl desc_od
                )
              )
            )
            (setq nw_obj
              (vla-addMtext Space
                (vlax-3d-point (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE")))
                0.0
                str
              )
            )
            (mapcar
              '(lambda (pr val)
                (vlax-put nw_obj pr val)
              )
              (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
              (list 4 (getvar "TEXTSIZE") 5 pt "Arial-Label" "Label" rtx)
            )
          )
        )
      )
      (T (princ "\nPas de données d'objet attachées"))
    )
  )
  (prin1)
)

[АлексЮстасу]

Hi, Bruno,

You create more useful than many!

Great, OD2LABEL_SIDE got more powerful!

Perhaps the most useful option would be to arrange many inscriptions along the polylines at once over the specified distance?
But somehow need to save the version of one inscription...