Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/26/2025 in all areas

  1. Hi I understand that it's sorting based on the first number in each row Maybe this can help you (defun c:draganK (/ nmarch nmarch1 arch arch1 linea separa<->campos lst lstA v) (defun separa<->campos (tx lstCtrs / c p l) (foreach c (vl-string->list tx) (if (member (setq c (chr c)) lstCtrs) (if p (setq l (cons (atof p) l) p nil)) (setq p (if p (strcat p c) c)) ) ) (reverse (if p (cons (atof p) l) l)) ) (setvar "DIMZIN" 0) (if (setq nmarch (getfiled "Select source file" "" "*" 2 ) ) (if (setq arch (open nmarch "r")) (if (setq arch1 (open (setq nmarch1 (strcat (vl-filename-directory nmarch) "\\" (vl-filename-base nmarch) "_sorted" (vl-filename-extension nmarch) ) ) "w" ) ) (progn (while (setq linea (read-line arch)) (setq lst (separa<->campos linea '("," ";" " ")) lstA (cons lst lstA) ) ) (foreach v (vl-sort lstA '(lambda (a b) (< (car a) (car b)))) (write-line (foreach x v (setq s (if s (strcat s "\t" (rtos x 2 3)) (rtos x 2 3)))) arch1) (setq s nil) ) ) ) ) ) (if arch (close arch) ) (if arch1 (progn (close arch1) (startapp "notepad" nmarch1) ) ) (princ) )
    2 points
  2. Why not use "dcl2lsp.lsp" to convert *.dcl to *.lsp which you can add to your main *.lsp that is to be compiled into *.VLX... Here is what I suggest (c:dcl2lsp)... (defun c:dcl2lsp ( / fname1 fn1 fname2 fn2 k fn1l fn2l ) (setq fname1 (getfiled "Select DCL file" "" "dcl" 16)) (setq fn1 (open fname1 "r")) (setq fname2 (getfiled "File to save" "" "lsp" 1)) (setq fn2 (open fname2 "w")) (while (setq fn1l (read-line fn1)) (setq fn2l fn1l) (setq k 0) (while (setq k (vl-string-search "\\" fn2l k)) (setq fn2l (vl-string-subst "\\\\" "\\" fn2l k)) (setq k (+ k 2)) ) (setq k 0) (while (setq k (vl-string-search "\"" fn2l k)) (setq fn2l (vl-string-subst "\\\"" "\"" fn2l k)) (setq k (+ k 2)) ) (setq fn2l (strcat "(write-line \"" fn2l "\" fn)")) (write-line fn2l fn2) ) (close fn1) (close fn2) (princ) ) (defun c:lsp2dcl ( / fname1 fn1 fname2 fn2 k fn1l fn2l ) (setq fname1 (getfiled "Select LSP file" "" "lsp" 16)) (setq fn1 (open fname1 "r")) (setq fname2 (getfiled "File to save" "" "dcl" 1)) (setq fn2 (open fname2 "w")) (while (setq fn1l (read-line fn1)) (setq fn2l fn1l) (setq fn2l (substr fn2l (+ (vl-string-search "\"" fn2l) 2) (- (vl-string-position (ascii "\"") fn2l nil T) (+ (vl-string-search "\"" fn2l) 1)))) (setq k 0) (while (setq k (vl-string-search "\\\"" fn2l k)) (setq fn2l (vl-string-subst "\"" "\\\"" fn2l k)) (setq k (+ k 1)) ) (setq k 0) (while (setq k (vl-string-search "\\\\" fn2l k)) (setq fn2l (vl-string-subst "\\" "\\\\" fn2l k)) (setq k (+ k 1)) ) (write-line fn2l fn2) ) (close fn1) (close fn2) (princ) ) (defun c:viewdcl ( / dclid return# filen fn lin ) (setq dclid (load_dialog (setq filen (getfiled "" "" "dcl" 16)))) (setq fn (open filen "r")) (while (or (eq (substr (setq lin (read-line fn)) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog")))) (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid) (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq return# (start_dialog)) (princ return#) (unload_dialog dclid) (princ) )
    1 point
  3. There is one or more programs supposed to be better than regular overkill for purchase around, not sure if that's a solution for you or would even work. I took a crack at work last week on your sample drawing, nothing worked 100%, it sometimes got an extra line that would have needed to be kept, or didn't delete the strays. It'll be Wednesday before I get back to work. I would have thought Overkill would have got those, but like you stated, nothing. Edit: Maybe something like this? This creates regions of the closed areas also makes a region of the entire selection, then deletes all but the regions. You could explode the regions after if you like. ;;; Removes everything after making closed areas regions ;;; ;;; https://www.cadtutor.net/forum/topic/97915-duplicated-lwpolylines/#findComment-671251 ;;; ;;; SLW210 (a.k.a. Steve Wilson) ;;; (defun c:ReSt ( / ss acadDoc ms allEnts ent i loopEnts reg regList sa) (vl-load-com) (setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq ms (vla-get-ModelSpace acadDoc)) ;; Select all LINE, ARC, LWPOLYLINE, CIRCLE (setq ss (ssget "X" '((0 . "LINE,ARC,LWPOLYLINE,CIRCLE")))) (if (not ss) (progn (prompt "\nNo entities found.") (exit) ) ) ;; Collect all VLA objects. (setq allEnts '()) (repeat (sslength ss) (setq ent (vlax-ename->vla-object (ssname ss 0))) (setq allEnts (cons ent allEnts)) (ssdel (ssname ss 0) ss) ; Remove from selection set ) ;; Create REGIONS from geometry. (setq sa (vlax-make-safearray vlax-vbObject (cons 0 (1- (length allEnts))))) (setq i 0) (foreach ent allEnts (vlax-safearray-put-element sa i ent) (setq i (1+ i)) ) ;; Create regions (setq regList (vl-catch-all-apply 'vla-AddRegion (list ms sa))) (if (vl-catch-all-error-p regList) (prompt "\nFailed to create regions. Check for gaps or open loops.") (progn ;; Delete original entitie if region creation succeeded. (foreach ent allEnts (if (not (vlax-erased-p ent)) (vla-delete ent)) ) (prompt "\n Regions created and original objects deleted.") ) ) (princ) )
    1 point
  4. Maybe this will help you (defun c:altObjs (/ cj a e l n at vlaObj) (if (setq a (getreal "\nNew height for (M)Texts/attributes: ")) (if (setq cj (ssget '((0 . "*TEXT,INSERT")))) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (if (wcmatch (cdr (assoc 0 (setq l (entget e)))) "*TEXT") (entmod (subst (cons 40 a) (assoc 40 l) l)) (if (= (vla-get-hasAttributes (setq vlaObj (vlax-ename->vla-object e))) :vlax-true) (foreach at (vlax-safearray->list (variant-value (vla-getattributes vlaObj))) (vla-put-Height at a) ) ) ) ) ) ) (princ) )
    1 point
×
×
  • Create New...