Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/17/2025 in Posts

  1. I've modified the code so that it also analyzes the files loaded from the profile. ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:buscaDefunsRepets (/ lstLsps arch nmarch linea lst as nbref separa<->palabras lstDefuns lstRepets tit i dale path escrutArch) (defun separa<->palabras (tx lstCtrs / c p l) (foreach c (vl-string->list tx) (if (member (setq c (chr c)) lstCtrs) (if p (setq l (cons (strcase p T) l) p nil)) (setq p (if p (strcat p c) c)) ) ) (reverse (if p (cons (strcase p T) l) l)) ) (defun escrutArch (nmarch / arch linea lst as nbref dale mirExtens) (defun mirExtens (nmarch) (if (not (wcmatch nmarch "*[.]@@@")) (strcat nmarch ".lsp") nmarch ) ) (if (and (setq nmarch (findfile (mirExtens nmarch))) (setq arch (open nmarch "r"))) (while (setq linea (read-line arch)) (cond ((and (wcmatch linea "*(defun *") (not (wcmatch linea "*\"(defun *,*\"*(defun [*] *,*\"*(defun [*]\"*"))) (setq lst (separa<->palabras linea '(" " "(" "\"")) pos (vl-position "defun" lst) nbref (nth (1+ pos) lst) ) (if lstDefuns (if (not (vl-some ; comprobamos cada defun acumulada '(lambda (v) (if (and (= (car v) nbref) (/= nbref "defun")); si la defun recien leída coincide con alguna de las encontradas anteriormente (if (setq lr (assoc nbref lstRepets)) (setq lstRepets (subst (append lr (list nmarch)) lr lstRepets)) (setq lstRepets (append lstRepets (list (append v (list nmarch))))) ) ) ) lstDefuns ) ) (setq lstDefuns (append lstDefuns (list (list nbref nmarch)))) ) (setq lstDefuns (append lstDefuns (list (list nbref nmarch)))) ) ) ((wcmatch linea "*(load *\")*") (setq lst (separa<->palabras linea '(" " "(" "\""))) (foreach v lst (if dale (setq dale (if (and (not (member (strcase v T) (list "acad2021.lsp" "acad2021doc.lsp"))) (or (= (length (setq lst1 (separa<->palabras v '(".")))) 1) (member (strcase (cadr lst1) T) extens) ) ) (escrutArch v) ) dale nil ) (if (= (strcase v T) "load") (setq dale T) ) ) ) ) ) ) ) (if arch (close arch)) ) (setq lstLsps (list "acad2021.lsp" "acad2021doc.lsp" "acadddd.lsp") extens '("lsp")) (foreach lsp lstLsps (if (and (findfile lsp) (setq arch (open (setq nmarch (findfile lsp)) "r"))) (escrutArch nmarch) ) ) (if arch (close arch)) (setq i 0) (while (setq nmarch (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup") (strcat (itoa (setq i (1+ i))) "StartUp"))) (escrutArch nmarch) ) (if lstRepets (if (setq arch (open (setq nmarch (strcat (VL-REGISTRY-READ "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders" "Personal") "\\informe.txt")) "w")) (foreach lr lstRepets (princ (strcat (if (not tit) (setq tit "FUNCTIONS DEFINED MULTIPLE TIMES:\n") "") "\n Function NAME \'" (car lr) "\' in:\n") arch) (foreach path (cdr lr) (princ (strcat "\t" path "\n") arch) ) ) ) ) (if arch (progn (close arch) (startapp "notepad" nmarch))) (princ) ) If after trying this nothing different comes out, then the problem isn't due to overlapping code. In that case, I would look at the system variables and any reactors your LISPs generate when loading.
    1 point
  2. I just started to do some VB in SolidWorks. So this is my first try: Option Explicit Dim swModel As SldWorks.ModelDoc2 Sub main() Dim aLine As SldWorks.SketchSegment Dim line As Object Set swModel = Application.SldWorks.ActiveDoc swModel.SketchManager.Insert3DSketch True 'tetrahedron side length Dim L As Double 'doh... number of segments Dim segs As Integer L = 10 segs = 22 Dim Xa, Ya, Za As Double 'point A is in the origin Xa = 0 Ya = 0 Za = 0 Dim Xb, Yb, Zb As Double 'point B is along Ox Xb = L Yb = 0 Zb = 0 Dim Xc, Yc, Zc As Double 'point C is in xOy plane Xc = L / 2# Yc = L * Sqrt(3) / 2# Zc = 0 Dim Xv, Yv, Zv As Double ' point V is right above the centroid of ABC Xv = L / 2# Yv = L * Sqrt(3) / 6 Zv = L * Sqrt(6) / 3# Dim i As Integer 'point1 walks along AV Dim Dx1, Dy1, Dz1, Dx2, Dy2, Dz2 As Double Dx1 = (Xv - Xa) / segs Dy1 = (Yv - Ya) / segs Dz1 = (Zv - Za) / segs 'point2 walks along BC Dx2 = (Xc - Xb) / segs Dy2 = (Yc - Yb) / segs Dz2 = (Zc - Zb) / segs 'point3 walks along BV Dim Dx3, Dy3, Dz3, Dx4, Dy4, Dz4 As Double Dx3 = (Xv - Xb) / segs Dy3 = (Yv - Yb) / segs Dz3 = (Zv - Zb) / segs 'point4 walks along CA Dx4 = (Xa - Xc) / segs Dy4 = (Ya - Yc) / segs Dz4 = (Za - Zc) / segs 'point5 walks along CV Dim Dx5, Dy5, Dz5, Dx6, Dy6, Dz6 As Double Dx5 = (Xv - Xc) / segs Dy5 = (Yv - Yc) / segs Dz5 = (Zv - Zc) / segs 'point6 walks along AB Dx6 = (Xb - Xa) / segs Dy6 = (Yb - Ya) / segs Dz6 = (Zb - Za) / segs 'draw those lines: For i = 0 To segs 'lines between point1 and point2: Set aLine = Draw(Xa + Dx1 * i, Ya + Dy1 * i, Za + Dz1 * i, Xb + Dx2 * i, Yb + Dy2 * i, Zb + Dz2 * i) 'the lines between point3 and point4: Set aLine = Draw(Xb + Dx3 * i, Yb + Dy3 * i, Zb + Dz3 * i, Xc + Dx4 * i, Yc + Dy4 * i, Zc + Dz4 * i) 'the segments between point5 and point6 Set aLine = Draw(Xc + Dx5 * i, Yc + Dy5 * i, Zc + Dz5 * i, Xa + Dx6 * i, Ya + Dy6 * i, Za + Dz6 * i) Next i ' Close sketch swModel.SketchManager.InsertSketch True 'swModel.ClearSelection2 True End Sub Function Draw(X1, Y1, Z1, X2, Y2, Z2 As Double) As SldWorks.SketchSegment Set Draw = swModel.SketchManager.CreateLine(X1, Y1, Z1, X2, Y2, Z2) End Function
    1 point
×
×
  • Create New...