Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/05/2025 in Posts

  1. Yes I know. 'vlr-remove-all' is executed during loading so that any reactor created with the previous code is erased. It was a quick solution. Additionally, it runs when the drawing is exited or at startup before any other application loads, so it would only affect those reactors that should remain between drawings. I assumed that Nikon does not use these reactors. But it is probably a risky assumption. So I guess I am "obliged" to fix it. Below, a solution that keeps the reactors even if the drawing closure is canceled, that respects any reactor created by another application, and that regenerates them in each drawing. (defun fota (/ arch cad cmd mens etq letq n er lx) (defun pregunta (a b / cad) (cond ((member (strcase (car b)) '("CLOSE" "_CLOSE" "QUIT" "_QUIT" "EXIT" "_EXIT")) (if (and *lstCmds* (setq mens (cmdsCargados)) (= (vlax-invoke-method (vlax-create-object "wscript.shell") 'popup "Print commands on screen?" 0 "Save commands name" 4) 6) ) (progn (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nInsertion point...")) 100 mens) (vlax-invoke-method (vlax-get-acad-object) 'Update) ) ) ) ((= (type a) 'VLR-Lisp-Reactor) (if (not (member (setq cad (substr (car b) 4 (- (strlen (car b)) 4))) *lstCmds*)) (setq *lstCmds* (cons (substr (car b) 4 (- (strlen (car b)) 4)) *lstCmds*)) ) ) ) ) (setq letq '("Nikon1" "Nikon2") *afI* nil) (foreach r (vlr-reactors) (foreach er (cdr r) (if (member (setq etq (vlr-data er)) letq) (if (wcmatch etq "Nikon1,Nikon2") (setq lx (cons er lx)) ) ) ) ) (if lx (foreach r lx (vlr-remove r))) (foreach sim (atoms-family 0) (if (wcmatch (setq cmd (strcase (vl-princ-to-string sim) T)) "c:*") (setq *afI* (cons sim *afI*)) ) ) (setq *r* (vlr-command-reactor "Nikon1" '((:vlr-commandwillStart . pregunta)))) (setq *r1* (vlr-lisp-reactor "Nikon2" '((:vlr-lispwillstart . pregunta)))) ) (defun cmdsCargados (/ cad) (setq *cadCmds* nil) (foreach sim (atoms-family 0) (if (not (member sim *afI*)) (if (and (wcmatch (setq cad (strcase (vl-princ-to-string sim) T)) "c:*") (member (strcase (substr cad 3)) *lstCmds*) ) (setq *cadCmds* (strcat (if *cadCmds* (strcat *cadCmds* "\n") "\\C1Comandos utilizados durante la sesi贸n:\\C256\n") (substr cad 3))) ) ) ) *cadCmds* ) (fota)
    1 point
  2. Hi, With your drawing, this code will correct the polylines. To be adapted if used in another drawing (ssget filter) (vl-load-com) (defun c:Correct3DPL ( / ss AcDoc Space nb n ename obj l_pt lay new_obj) (setq ss (ssget "_X" '((0 . "POLYLINE") (67 . 0) (8 . "CTL_PNT") (66 . 1) (70 . 9)))) (cond (ss (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) nb 0 ) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ename) l_pt (vlax-get obj 'Coordinates) lay (vlax-get obj 'Layer) ) (cond ((eq (length l_pt) 12) (vla-delete obj) (setq new_obj (vlax-invoke Space 'Add3dPoly (cdddr l_pt))) (vla-put-Closed new_obj :vlax-true) (vla-put-Layer new_obj lay) (setq nb (1+ nb)) ) ) ) (princ (strcat "\n" (itoa nb) " polylines corrected.")) ) ) (prin1) )
    1 point
×
×
  • Create New...