https://www.cadforum.cz/forum/ Fri, 31 Jul 2026 22:07:11 +0000 Thu, 27 Oct 2011 23:11:55 +0000 http://blogs.law.harvard.edu/tech/rss Web Wiz Forums 12.04 360 https://www.cadforum.cz/forum/RSS_post_feed.asp?TID=13810 https://www.cadforum.cz/forum/forum_images/web_wiz_forums.png https://www.cadforum.cz/forum/ https://www.cadforum.cz/forum/forum_posts.asp?TID=13810&PID=65155&title=kopiruj-text-zmena-farby#65155 Autor: DodoSVK
Předmět: 13810
Zasláno: 27.říj.2011 v 23:11

Dobry den.

Chcel by som sa opytat ci by bolo narocne mierne pozmenit tento zdrojovy kod lispu, ktory je urceny na kopirovanie textu.

Chcel by som dosiahnut nasledovny efekt - po prekopirovani textu zo zdrojovej textovej entity na cielovu entitu, by sa zaroven zmenila farba zdrojovej textovej entity napriklad na  cervenu. (Aby som vedel ze danu textovu entitu som uz kopiroval)

 Ak to nieje jednoduche, tak si poradim inak ako si to budem znacit, ale ak je to otazka doplnenia jedneho riadku budem rad ak mi pomozete a mozno sa takato pomocka zide aj vam.

Vopred dakujem.


; Kopie textu ze zdrojové textové entity na cílové entity (ve stejném prostoru)
; (copy text content from a source text entity to target text entities)
; z www.cadforum.cz (Pajas)
;
(defun C:KOPIRUJTEXT (/ sel text blky jb te s_jba at atr) ;TE
  (while (not sel)
    (princ "\n*** Vyberte kopírovaný text: ")
    (setq sel (entget (car (nentsel))))
    (if    (and (/= (cdr (assoc 0 sel)) "TEXT")
         (/= (cdr (assoc 0 sel)) "MTEXT")
         (/= (cdr (assoc 0 sel)) "ATTDEF")
         (/= (cdr (assoc 0 sel)) "ATTRIB")
    )
      (progn
    (prompt
      "\n*** Vybraná entita není text, mtext ani atribut."
    )
    (setq sel nil)
      )
      sel
    )
  )
  (if (or (= (cdr (assoc 0 sel)) "TEXT")
      (= (cdr (assoc 0 sel)) "MTEXT")
      (= (cdr (assoc 0 sel)) "ATTRIB")
      )
    (setq text (cdr (assoc 1 sel)))
    (setq text (cdr (assoc 2 sel)))
  )
  (princ text)
;;;Výběr atributů
  (princ
    "\n*** Vyberte položky pro nakopírování nového textu: "
  )
  (setq    blky (ssget
           '((-4 . "<OR")
         (0 . "TEXT")
         (0 . "MTEXT")
         (0 . "ATTDEF")
         (-4 . "OR>")
        )
         )
  )
  (setq nt 0)
  (repeat (sslength blky)
    (setq jb (ssname blky nt)
      te (cdr (assoc '0 (entget jb)))
      nt (1+ nt)
    )
    (if    (or (= "TEXT" te) (= "MTEXT" te) (= "ATTDEF" te))
      (setq s_jba (append s_jba (list (list jb jb)))
          ;;seznam entit
      )
    )
  )
  (princ (strcat "*** Nalezeno "
         (itoa (length s_jba))
         " přepisovatelných položek."
     )
  )
;;;Číslování
  (setq nt 0)
  (while (< nt (length s_jba))
    (setq atr (cdr (assoc '0 (entget (cadr (nth nt s_jba))))))
    (if    (or (= atr "TEXT") (= atr "MTEXT"))
      (setq at
         (subst
           (cons 1 text)
           (assoc '1 (entget (cadr (nth nt s_jba))))
           (entget (cadr (nth nt s_jba)))
         )
      )
      (setq at
         (subst
           (cons 2 text)
           (assoc '2 (entget (cadr (nth nt s_jba))))
           (entget (cadr (nth nt s_jba)))
         )
      )
    )
    (entmod at)
    (entupd (car (nth nt s_jba)))
    (setq nt (1+ nt))
  )
  (princ)
)
;;;Konec Okopírování textu
]]> Thu, 27 Oct 2011 23:11:55 +0000 https://www.cadforum.cz/forum/forum_posts.asp?TID=13810&PID=65155&title=kopiruj-text-zmena-farby#65155