Lee Mac Posted June 25, 2012 Posted June 25, 2012 Lee, I really like this approach! Thank you Mircea, glad to have provided some inspiration Quote
southwood1990 Posted June 25, 2012 Author Posted June 25, 2012 Dear Mircea Thanks you so much the code worked a treat, you have saved me hours of work, Regards Mark Quote
asos2000 Posted June 26, 2012 Posted June 26, 2012 My version: (defun c:c2p ( / e i s ) ... ) There are 2 questions - What is deference between (assoc 010 e) and (assoc 10 e)? - I used your list as a basic but not working (defun c:c2p ( / e i s ) (SelSim) (eMake) (if (setq s ss) (repeat (setq i (sslength s)) (setq e (entget (ssname s (setq i (1- i))))) (if (insert (assoc 10 e) "EC-SteelSection") (entdel (cdr (assoc -1 e))) ) ) ) (princ) ) The error Redefining block "EC-SteelSection" ; error: bad DXF group: (10 10 201479.0 -200045.0 0.0) Full code ;|(defun c:c2p ( / e i s ) (if (setq s (ssget "_X" '((0 . "CIRCLE")))) (repeat (setq i (sslength s)) (setq e (entget (ssname s (setq i (1- i))))) (if (entmake (list '(0 . "POINT") (assoc 010 e) (assoc 008 e) (cond ((assoc 006 e)) ('(006 . "BYLAYER"))) (cond ((assoc 039 e)) ('(039 . 0.0))) (cond ((assoc 062 e)) ('(062 . 256))) (cond ((assoc 370 e)) ('(370 . -1))) (assoc 210 e) (assoc 410 e) ) ) (entdel (cdr (assoc -1 e))) ) ) ) (princ) )|; (defun c:c2p ( / e i s ) (SelSim) (eMake) (if (setq s ss) (repeat (setq i (sslength s)) (setq e (entget (ssname s (setq i (1- i))))) (if (insert (assoc 10 e) "EC-SteelSection") (entdel (cdr (assoc -1 e))) ) ) ) (princ) ); defun (defun Insert (pt Nme) (entmakex (list (cons 0 "INSERT") (cons 2 Nme) (cons 10 pt)))) (defun eMake () (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "EC-SteelSection") (10 0.0 0.0 0.0) (70 . 0) ) ) (entmake '((0 . "HATCH") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbHatch") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (2 . "SOLID") (70 . 1) (71 . 0) (91 . 1) (92 . 7) (72 . 1) (73 . 1) (93 . 2) (10 0.5 0.0 0.0) (42 . 1.0) (10 -0.5 0.0 0.0) (42 . 1.0) (97 . 0) (75 . 0) (76 . 1) (47 . 0.01021840100963) (98 . 1) (10 0.104229146438229 -0.090542320619988 0.0) (450 . 0) (451 . 0) (460 . 0.0) (461 . 0.0) (452 . 1) (462 . 1.0) (453 . 2) (463 . 0.0) (63 . 5) (421 . 255) (463 . 1.0) (63 . 7) (421 . 16777215) (470 . "LINEAR") ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))) (princ) ) ;;; ------------------------------------------------------------------------------------- ;;; SelSim.lsp v0.3 ;;; Copyright? 2008-02-26 ;;; Irn? Barnard ;;; Contact: irneb@users.sourceforge.net ;;; ;;; ;;; ------------------------------------------------------------------------------------- ;;; License ;;; ------------------------------------------------------------------------------------- ;;; This file is part of Caddons. ;;; ;;; Caddons is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation, either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; Caddons is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with Caddons. If not, see <http://www.gnu.org/licenses/>. ;;; ;;; ;;; ------------------------------------------------------------------------------------- ;;; Disclaimer ;;; ------------------------------------------------------------------------------------- ;;; The following program(s) are provided "as is" and with all faults. ;;; Irn? Barnard DOES NOT warrant that the operation of the program(s) ;;; will be uninterrupted and/or error free. ;;; ;;; ;;; ------------------------------------------------------------------------------------- ;;; Summary of routines contained in this file ;;; ------------------------------------------------------------------------------------- ;;; Allows selection filtering by using properties of an example object ;;; Usage: Command SelSim or SelSimilar. Can be used transparently by prefixing ;;; with a single quote ('). ;;; ;;; Revision History: ;;; 0.1 First release (2008-02-26) ;;; 0.2 Added blockname/ effective blockname filtering, incorporated into current ;;; selection so highlight works as well (2008-04-01) ;;; 0.3 Re written and consolidated. Added dialog source into LSP so it works from ;;; any folder. Added All/None buttons to dialog. (2012-04-14) ;;; ;;; ------------------------------------------------------------------------------------- ;;; To Do: ;;; ------------------------------------------------------------------------------------- (vl-load-com) (defun SelSim:SaveSettings (settings / ) (if Caddons:PutConfig (foreach item settings (Caddons:PutConfig (strcat "SelSim\\" (itoa (car item))) (cdr item))) (foreach item settings (SetEnv (strcat "SelSim\\" (itoa (car item))) (vl-princ-to-string (cdr item))))) (setq *SelSim:Settings* settings)) (defun SelSim:LoadSettings ( / s) (setq *SelSim:Settings* '((0 . 1) (2 . 2) (3 . 0) (6 . 1) (7 . 0) (8 . 1) (40 . 0) (48 . 0) (50 . 0) (62 . 1) (370 . 0) (390 . 0))) (if Caddons:wcGetConfig (foreach item (Caddons:wcGetConfig "SelSim*") (setq item (cons (atoi (substr (car item) ) (cdr item)) *SelSim:Settings* (if (setq s (assoc (car item) *SelSim:Settings*)) (subst item s *SelSim:Settings*) (cons item *SelSim:Settings*)))) (foreach item '(0 2 3 6 7 8 40 48 50 62 370 390) (if (setq s (GetEnv (strcat "SelSim\\" (itoa item)))) (setq item (cons item (atoi s)) *SelSim:Settings* (if (setq s (assoc (car item) *SelSim:Settings*)) (subst item s *SelSim:Settings*) (cons item *SelSim:Settings*)))))) *SelSim:Settings*) (SelSim:LoadSettings) (defun SelSim:Settings (/ dcl f settings ~ToggleAll) (if (setq f (open (setq dcl (strcat (getvar "TempPrefix") "SelSim.DCL")) "w")) (progn (princ (strcat "SelSim : dialog { label = \"Select Similar Setup\";\n" " : row {\n" " : boxed_column { label = \"General Properties\";\n" " : toggle { label = \"Entity Type (e.g. LINE, TEXT, etc.)\"; key = \"0\"; }\n" " : toggle { label = \"Line Type\"; key = \"6\"; }\n" " : toggle { label = \"Layer\"; key = \"8\"; }\n" " : toggle { label = \"LT Scale\"; key = \"48\"; }\n" " : toggle { label = \"Colour\"; key = \"62\"; }\n" " : toggle { label = \"Line Weight\"; key = \"370\"; }\n" " : radio_row { label = \"Block Name\"; key = \"2\";\n" " : radio_button { label = \"Ignore\"; key = \"20\"; }\n" " : radio_button { label = \"Specific\"; key = \"21\"; }\n" " : radio_button { label = \"Effective\"; key = \"22\"; }\n" " }\n" " }\n" " : column {\n" " : boxed_column { label = \"Text Specific Properties\";\n" " : toggle { label = \"Style\"; key = \"7\"; }\n" " : toggle { label = \"Height\"; key = \"40\"; }\n" " : toggle { label = \"Rotation\"; key = \"50\"; }\n" " }\n" " : boxed_column { label = \"Style Based Properties\";\n" " : toggle { label = \"Style\"; key = \"3\"; }\n" " }\n" " : row {\n" " fixed_width = true;\n" " alignment = centered;\n" " : retirement_button { label = \" &All \"; key = \"all\"; }\n" " : spacer { width = 2; }\n" " : retirement_button { label = \" &None \"; key = \"none\"; }\n" " }\n" " ok_cancel;\n" " }\n" " }\n" "}\n") f) (close f) (setq settings (SelSim:LoadSettings)) (if (and (setq dcl (load_dialog dcl)) (new_dialog "SelSim" dcl)) (progn (foreach item settings (set_tile (itoa (car item)) (itoa (cdr item))) (action_tile (itoa (car item)) "(setq settings (subst (cons (read $key) (read $value)) (assoc (read $key) settings) settings))")) (setq f (cdr (assoc 2 settings))) (defun ~ToggleAll (on / ) (foreach item '(0 3 6 7 8 40 48 50 62 370) (setq settings (subst (cons item (if on 1 0)) (assoc item settings) settings)) (set_tile (itoa item) (if on "1" "0"))) (set_tile "2" (if on "22" "20")) (setq settings (subst (cons 2 (if on 22 20)) (assoc 2 settings) settings))) (action_tile "all" "(~ToggleAll t)") (action_tile "none" "(~ToggleAll nil)") (if (= (start_dialog) 1) (SelSim:SaveSettings settings)) (unload_dialog dcl)))))) (defun SelSim:BlkEffectiveNameFilter (en / efName name lst) (setq efName (vla-get-EffectiveName (vlax-ename->vla-object en))) (vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-for eo blk (if (and (eq (vla-get-ObjectName eo) "AcDbBlockReference") (eq (vla-get-EffectiveName eo) efName) (not (vl-Position (setq name (vla-get-Name eo)) lst))) (setq lst (cons name lst))))) (if lst (apply 'strcat (cons efName (mapcar (function (lambda (name) (strcat ",`" name))) lst))) efName)) (defun SelSim:Filter (ed / item flt found) (foreach item '((6 . "BYLAYER") (48 . 1.0) (62 . 256) (370 . -1)) (if (and (setq found (assoc (car item) *SelSim:Settings*)) (= (cdr found) 1)) (if (setq found (assoc (car item) ed)) (setq flt (cons found flt)) (setq flt (cons item flt))))) (if (and (eq (cdr (assoc 0 ed)) "INSERT") (setq item (assoc 2 *SelSim:Settings*))) (cond ((= (cdr item) 22) (setq flt (cons (cons 2 (SelSim:BlkEffectiveNameFilter (cdr (assoc -1 ed)))) flt))) ((= (cdr item) 21) (setq flt (cons (cons 2 (if (wcmatch (setq item (cdr (assoc 2 ed))) "`**") (strcat "`" name) name)) flt))))) (foreach item '(3 7 40 50 0) (if (and (= (cdr (assoc item *SelSim:Settings*)) 1) (setq item (assoc item ed))) (setq flt (cons item flt)))) flt) (defun SelSim (/ ss en ed flst) (if (setq ss (cadr (ssgetfirst))) (setq en (ssname ss 0)) (if (not (setq en (car (entsel "Select source entity: ")))) (quit))) (setq ed (entget en)) (sssetfirst nil nil) (while (progn (prompt "Filter by: ") (princ (setq flst (SelSim:Filter ed))) (prompt "\nSelect by filter <Enter> for settings].") (not (setq ss (ssget flst)))) (SelSim:Settings)) ; (if (> (logand (getvar "CMDACTIVE") 1) 0) ; ss ; (sssetfirst nil ss))) (defun c:SelSimilar (/) (SelSim)) ;|?Visual LISP? Format Options? (120 2 1 0 nil "end of " 100 9 0 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|; Quote
MSasu Posted June 26, 2012 Posted June 26, 2012 There cannot be made many comments on your trouble-maker code since contains many functions which definition you didn't posted. Most probably this cause you trouble: (insert [color=red](cdr [/color](assoc 10 e)[color=red])[/color] "EC-SteelSection") For that 10 vs. 010, that is purely estetical. Quote
Lee Mac Posted June 26, 2012 Posted June 26, 2012 - What is deference between (assoc 010 e) and (assoc 10 e)? For that 10 vs. 010, that is purely aesthetical. Precisely Quote
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.