namnhim Posted February 28, 2015 Share Posted February 28, 2015 please help, Lisp localize objects with the same content! sorry for my bad English! khoanh ve Engli.dwg Quote Link to comment Share on other sites More sharing options...
BIGAL Posted February 28, 2015 Share Posted February 28, 2015 Something like this http://www.cadtutor.net/forum/showthread.php?91084-Area-Statement-Under-Layer-quot-Acquired-No.-amp-Area-quot-to-the-csv Quote Link to comment Share on other sites More sharing options...
namnhim Posted March 1, 2015 Author Share Posted March 1, 2015 no, All Text ONT => BOUNDARY, All Text CLN => BOUNDARY (or HATCH) Quote Link to comment Share on other sites More sharing options...
mailmaverick Posted March 1, 2015 Share Posted March 1, 2015 Kindly attach your drawing. Quote Link to comment Share on other sites More sharing options...
namnhim Posted March 2, 2015 Author Share Posted March 2, 2015 Thank you, khoanh ve Engli.dwg Quote Link to comment Share on other sites More sharing options...
mailmaverick Posted March 2, 2015 Share Posted March 2, 2015 (edited) (defun c:test () (vl-load-com) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat (str mtx / _replace rx) (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new)) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda () (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '(("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique (l / x r) (while l (setq x (car l) l (vl-remove x (cdr l)) r (cons x r) ) ) (reverse r) ) ;; ;; ;; Source : http://www.theswamp.org/index.php?topic=10371.0 ;Union polylines ;Stefan M. 09.01.2014 (defun UNIP (lst / *error* i lst r1 reg ss sysvar prop) (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))) (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace ) ) ) (vla-startundomark acDoc) (setq sysvar (mapcar 'getvar '(peditaccept draworderctl cmdecho))) (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*")) (princ (strcat "\nError: " msg))) (mapcar 'setvar '(peditaccept draworderctl cmdecho) sysvar) (vla-endundomark acDoc) (princ) ) (foreach x lst (vla-put-closed x :vlax-true)) (setq prop (mapcar '(lambda (p) (vlax-get (car lst) p)) '(Layer LineType Color))) (setq reg (vlax-invoke ms 'AddRegion lst)) (foreach x lst (if (not (vlax-erased-p x)) (vla-delete x) ) ) (setq r1 (car reg)) (foreach x (cdr reg) (vlax-invoke r1 'boolean acunion x)) (mapcar '(lambda (p v) (vlax-put r1 p v)) '(Layer LineType Color) prop) (setq lst (apply 'append (mapcar '(lambda (a) (if (listp a) (mapcar 'vlax-vla-object->ename a) (list (vlax-vla-object->ename a)) ) ) (mapcar '(lambda (e / p) (if (eq (vla-get-objectname e) "AcDbRegion") (progn (setq p (vlax-invoke e 'explode)) (vla-delete e) p) e ) ) (vlax-invoke r1 'explode) ) ) ) ) (vla-delete r1) (setq ss (ssadd)) (foreach x lst (ssadd x ss)) (mapcar 'setvar '(peditaccept draworderctl cmdecho) '(1 0 0)) (command "_pedit" "_m" ss "" "_j" "" "") (*error* nil) (princ) ) ;; ;; ========================== ;; ACTUAL PROGRAM STARTS HERE ;; ========================== ;; (setvar "cmdecho" 0) (setq oldsnapmode (getvar "snapmode")) (setq oldosmode (getvar "osmode")) (setq oldlayer (getvar "clayer")) (setq oldorthomode (getvar "orthomode")) (setvar "snapmode" 0) (setvar "osmode" 0) (setvar "orthomode" 0) (setq sset (ssget "_:L" '((0 . "*TEXT")))) (setq textlist nil) (setq textstrlist nil) (repeat (setq n (sslength sset)) (setq ent (ssname sset (setq n (1- n)))) (setq obj (vlax-ename->vla-object ent)) (setq txtstring (strcat (LM:UnFormat (vla-get-textstring obj) nil))) (setq textlist (cons (list ent txtstring) textlist)) (setq textstrlist (cons txtstring textstrlist)) ) (setq uniqtextlist (LM:Unique textstrlist)) (setq finallist nil) (foreach xx uniqtextlist (setq templist nil) (foreach yy textlist (if (equal xx (cadr yy)) (progn (setq templist (cons (car yy) templist))) ) ) (setq finallist (cons (list xx templist) finallist)) ) (setq cnt 1) (foreach xx finallist (setq lyrname (strcat "LYR-" (car xx))) (if (not (tblsearch "LAYER" lyrname)) (command "_.-layer" "M" lyrname "C" cnt "" "L" "Continuous" "" "LW" 0.25 "" "") ) (setq cnt (1+ cnt)) (setq entlist (cadr xx)) (setvar 'clayer lyrname) (setq joinlist nil) (foreach yy entlist (setq obj (vlax-ename->vla-object yy)) (setq inspt (vlax-safearray->list (vlax-variant-value (vla-get-textalignmentpoint obj)))) (command "-boundary" inspt "") (setq joinlist (cons (vlax-ename->vla-object (entlast)) joinlist)) ) (UNIP joinlist) ) (setvar "snapmode" oldsnapmode) (setvar "orthomode" oldorthomode) (setvar "osmode" oldosmode) (if (tblsearch "LAYER" oldlayer) (setvar "clayer" oldlayer) ) (princ) ) Run by typing TEST. Edited March 3, 2015 by mailmaverick Quote Link to comment Share on other sites More sharing options...
namnhim Posted March 2, 2015 Author Share Posted March 2, 2015 very good but boundary ONT? Quote Link to comment Share on other sites More sharing options...
mailmaverick Posted March 2, 2015 Share Posted March 2, 2015 When i run the routine, two boundaries get created, 1st for all ONT texts and 2nd for all CLN texts, as desired by you. What is the problem in the routine ? Quote Link to comment Share on other sites More sharing options...
namnhim Posted March 3, 2015 Author Share Posted March 3, 2015 Thank you! I want something like this: 2.dwg Quote Link to comment Share on other sites More sharing options...
mailmaverick Posted March 3, 2015 Share Posted March 3, 2015 Kindly check my modified code in Post #6. Quote Link to comment Share on other sites More sharing options...
namnhim Posted March 3, 2015 Author Share Posted March 3, 2015 Thanh you! You check his help of Text BOUNDARY ONT Quote Link to comment Share on other sites More sharing options...
mailmaverick Posted March 3, 2015 Share Posted March 3, 2015 My program gives this output. What is the problem in this ?? Quote Link to comment Share on other sites More sharing options...
namnhim Posted March 4, 2015 Author Share Posted March 4, 2015 Thanh'k mailmaverick Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.