Recent Posts

Pages: 1 ... 8 9 [10]
91
AutoLISP (Vanilla / Visual) / Re: 3d polyline splitting
« Last post by ribarm on May 08, 2024, 09:53:53 AM »
And this code is opposite of splitting by adding vertices... It's called "diet3dps" like my latest with lwpolyline that I coded recently...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:diet3dps ( / *error* unique getvertices collinear-p group_collinear_pts cmd uf s in pl plx cf vl nvl gg )
  2.  
  4.  
  5.   (defun *error* ( m )
  6.     (while (= 8 (logand 8 (getvar (quote undoctl))))
  7.       (if command-s
  8.         (command-s "_.UNDO" "_E")
  9.         (vl-cmdf "_.UNDO" "_E")
  10.       )
  11.     )
  12.     (if uf
  13.       (if command-s
  14.         (command-s "_.UCS" "_P")
  15.         (vl-cmdf "_.UCS" "_P")
  16.       )
  17.     )
  18.     (if cmd
  19.       (setvar (quote cmdecho) cmd)
  20.     )
  21.     (if m
  22.       (prompt m)
  23.     )
  24.     (princ)
  25.   )
  26.  
  27.   (defun unique ( lst )
  28.     (if lst
  29.       (cons (car lst)
  30.         (unique
  31.           (vl-remove-if (function (lambda ( x ) (equal x (car lst) 1e-6)))
  32.             (cdr lst)
  33.           )
  34.         )
  35.       )
  36.     )
  37.   )
  38.  
  39.   (defun getvertices ( c / i p ptlst )
  40.     (setq i -1)
  41.     (while (<= (setq i (1+ i)) (vlax-curve-getendparam c))
  42.       (setq p (vlax-curve-getpointatparam c i))
  43.       (setq ptlst (cons p ptlst))
  44.     )
  45.     (reverse ptlst)
  46.   )
  47.  
  48.   (defun collinear-p ( p1 p p2 )
  49.     (and
  50.       (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  51.       (equal (angle p1 p2) (angle p1 p) 1e-6)
  52.       (equal (angle p1 p2) (angle p p2) 1e-6)
  53.     )
  54.   )
  55.  
  56.   (defun group_collinear_pts ( ptlst / a b c g gg )
  57.     (while ptlst
  58.       (setq a (car ptlst) b (cadr ptlst) c (caddr ptlst))
  59.       (while (and c (collinear-p a b c))
  60.         (if (not (vl-position a g))
  61.           (setq g (cons a g))
  62.         )
  63.         (if (not (vl-position b g))
  64.           (setq g (cons b g))
  65.         )
  66.         (if (not (vl-position c g))
  67.           (setq g (cons c g))
  68.         )
  69.         (setq ptlst (cdr ptlst))
  70.         (setq a (car ptlst) b (cadr ptlst) c (caddr ptlst))
  71.       )
  72.       (setq ptlst (cdr ptlst))
  73.       (if g
  74.         (setq gg (cons (reverse g) gg))
  75.       )
  76.       (setq g nil)
  77.     )
  78.     (reverse gg)
  79.   )
  80.  
  81.   (setq cmd (getvar (quote cmdecho)))
  82.   (setvar (quote cmdecho) 0)
  83.   (while (= 8 (logand 8 (getvar (quote undoctl))))
  84.     (if command-s
  85.       (command-s "_.UNDO" "_E")
  86.       (vl-cmdf "_.UNDO" "_E")
  87.     )
  88.   )
  89.   (if command-s
  90.     (command-s "_.UNDO" "_BE")
  91.     (vl-cmdf "_.UNDO" "_BE")
  92.   )
  93.   (if (= 0 (getvar (quote worlducs)))
  94.     (progn
  95.       (if command-s
  96.         (command-s "_.UCS" "_W")
  97.         (vl-cmdf "_.UCS" "_W")
  98.       )
  99.       (setq uf t)
  100.     )
  101.   )
  102.   (prompt "\nPick reference 3D polyline(s)...")
  103.   (if (setq s (ssget (list (cons 0 "POLYLINE") (cons -4 "<or") (cons 70 8) (cons 70 9) (cons -4 "or>"))))
  104.     (repeat (setq in (sslength s))
  105.       (setq plx (entget (setq pl (ssname s (setq in (1- in))))))
  106.       (if (= 9 (cdr (assoc 70 plx)))
  107.         (setq cf t)
  108.       )
  109.       (setq vl (getvertices pl))
  110.       (setq nvl vl)
  111.       (setq gg (group_collinear_pts nvl))
  112.       (foreach g gg
  113.         (setq g (cdr g) g (reverse (cdr (reverse g))))
  114.         (foreach p g
  115.           (setq nvl (vl-remove-if (function (lambda ( x ) (equal p x 1e-6))) nvl))
  116.         )
  117.       )
  118.       (if cf
  119.         (setq nvl (reverse (cdr (reverse nvl))))
  120.       )
  121.       (setq nvl (unique nvl))
  122.       (vl-cmdf "_.3DPOLY")
  123.       (foreach v nvl
  124.         (vl-cmdf "_non" v)
  125.       )
  126.       (if cf
  127.         (while (< 0 (getvar (quote cmdactive)))
  128.           (vl-cmdf "_C")
  129.         )
  130.         (while (< 0 (getvar (quote cmdactive)))
  131.           (vl-cmdf "")
  132.         )
  133.       )
  134.       (setq nvl nil cf nil gg nil)
  135.     )
  136.   )
  137.   (*error* nil)
  138. )
  139.  

HTH.
M.R.
92
AutoLISP (Vanilla / Visual) / Re: 3d polyline splitting
« Last post by ribarm on May 08, 2024, 09:16:36 AM »
Try this code...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:split3dpolyssegs ( / *error* getvertices unit d cmd uf s in plx pl vl a b dd n sd nvl k )
  2.  
  4.  
  5.   (defun *error* ( m )
  6.     (if uf
  7.       (if command-s
  8.         (command-s "_.UCS" "_P")
  9.         (vl-cmdf "_.UCS" "_P")
  10.       )
  11.     )
  12.     (while (= 8 (logand 8 (getvar (quote undoctl))))
  13.       (if command-s
  14.         (command-s "_.UNDO" "_E")
  15.         (vl-cmdf "_.UNDO" "_E")
  16.       )
  17.     )
  18.     (if cmd
  19.       (setvar (quote cmdecho) cmd)
  20.     )
  21.     (if m
  22.       (prompt m)
  23.     )
  24.     (princ)
  25.   )
  26.  
  27.   (defun getvertices ( c / i p plst )
  28.     (setq i -1)
  29.     (while (<= (setq i (1+ i)) (vlax-curve-getendparam c))
  30.       (setq p (vlax-curve-getpointatparam c i))
  31.       (setq plst (cons p plst))
  32.     )
  33.     (reverse plst)
  34.   )
  35.  
  36.   (defun unit ( v / d )
  37.     (if (not (equal (setq d (distance (list 0.0 0.0 0.0) v)) 0.0 1e-6))
  38.       (mapcar (function (lambda ( x ) (/ x d))) v)
  39.     )
  40.   )
  41.  
  42.   (setq d 0.7) ;;; initial setting - change to suit your needs ;;;
  43.  
  44.   (setq cmd (getvar (quote cmdecho)))
  45.   (setvar (quote cmdecho) 0)
  46.   (while (= 8 (logand 8 (getvar (quote undoctl))))
  47.     (if command-s
  48.       (command-s "_.UNDO" "_E")
  49.       (vl-cmdf "_.UNDO" "_E")
  50.     )
  51.   )
  52.   (if command-s
  53.     (command-s "_.UNDO" "_BE")
  54.     (vl-cmdf "_.UNDO" "_BE")
  55.   )
  56.   (if (= 0 (getvar (quote worlducs)))
  57.     (progn
  58.       (if command-s
  59.         (command-s "_.UCS" "_W")
  60.         (vl-cmdf "_.UCS" "_W")
  61.       )
  62.       (setq uf t)
  63.     )
  64.   )
  65.   (prompt "\nPick reference 3D polyline(s)...")
  66.   (if (setq s (ssget (list (cons 0 "POLYLINE") (cons -4 "<or") (cons 70 8) (cons 70 9) (cons -4 "or>"))))
  67.     (repeat (setq in (sslength s))
  68.       (setq plx (entget (setq pl (ssname s (setq in (1- in))))))
  69.       (setq vl (getvertices pl))
  70.       (while (setq b (cadr vl))
  71.         (setq dd (distance (setq a (car vl)) b))
  72.         (if (> (fix (/ dd d)) 0)
  73.           (setq n (fix (/ dd d)))
  74.           (setq n (fix (1+ (/ dd d))))
  75.         )
  76.         (setq sd (/ dd n))
  77.         (setq nvl (cons a nvl))
  78.         (setq k 0)
  79.         (repeat n
  80.           (setq nvl (cons (mapcar (function +) a (mapcar (function *) (unit (mapcar (function -) b a)) (list (* (setq k (1+ k)) sd) (* k sd) (* k sd)))) nvl))
  81.         )
  82.         (setq vl (cdr vl))
  83.       )
  84.       (setq a (car nvl))
  85.       (setq nvl (cdr nvl))
  86.       (if (not (vlax-curve-isclosed pl))
  87.         (setq nvl (cons a nvl))
  88.       )
  89.       (setq nvl (reverse nvl))
  90.       (vl-cmdf "_.3DPOLY")
  91.       (foreach v nvl
  92.         (vl-cmdf "_non" v)
  93.       )
  94.       (if (vlax-curve-isclosed pl)
  95.         (while (< 0 (getvar (quote cmdactive)))
  96.           (vl-cmdf "_C")
  97.         )
  98.         (while (< 0 (getvar (quote cmdactive)))
  99.           (vl-cmdf "")
  100.         )
  101.       )
  102.       (setq nvl nil)
  103.     )
  104.   )
  105.   (*error* nil)
  106. )
  107.  

Regards, M.R.
93
BricsCAD Users / Status Bar Freeze: Requires Window Minimize Then Maximize to Function Again
« Last post by CEHill on May 08, 2024, 07:29:25 AM »
On both others and my BricsCAD installations v22 through v24, the status bar works intermittently but then becomes nonfunctional (or freezes). This occurs on less demanding design tasks containing only basic 2D elements with no external resource file references, of course, no 3D, point clouds, etc.

ISSUE
The coordinates display and buttons become unresponsive.

WORKAROUND
Only the workaround in the title, first minimizing and then maximizing the application window restores its functionality. We are on the Windows 11 OS.

QUESTIONS
1.) Has anyone experienced this issue?
2.) If so, how did you resolve it?

UPDATE
I updated the graphics driver. There was no change: the status bar issue remained.

See attached laptop specifications.

Thanks,

Clint
 
94
AutoLISP (Vanilla / Visual) / Re: Attribute Text Width
« Last post by MeasureUp on May 07, 2024, 11:17:55 PM »
There is nothing special in the drawing file or template.

My starting point is an example in the ActiveX section in HELP showed below.
I have no idea to redefine the "oML" in my case by given a title block "BLK-01" and an attribute "ATT-01" based on multi page drawing.

I'd like to learn this method.
Thanks.

Code: [Select]
(defun c:Example_TextManipulation()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    ;; Define the leader points
    (setq points (vlax-make-safearray vlax-vbDouble '(0 . 14)))
    (vlax-safearray-fill points '(1 1 0
                                  1 2 0
                                  2 2 0
                                  3 2 0
                                  4 4 0
                                 )
    )
    (setq i 0)

    (setq modelSpace (vla-get-ModelSpace doc))
    (setq oML (vla-AddMLeader modelSpace points i))
   
    (vla-put-TextWidth oML 7.4)
)
95
AutoLISP (Vanilla / Visual) / Re: Minimum distance between two vlax-curve objects
« Last post by Halfuller4u5 on May 07, 2024, 06:14:49 PM »
Thank you Joe!  Working parallel circuitry and your code works great for locating minimum margins between two polyline objects.  Appreciated!
96
AutoLISP (Vanilla / Visual) / Re: 3d polyline splitting
« Last post by mariolino0099 on May 07, 2024, 05:56:33 AM »
Please can anyone help me ?
Thanks
97
AutoLISP (Vanilla / Visual) / Re: finding nested xrefs - AutoLISP
« Last post by Lee Mac on May 07, 2024, 05:03:23 AM »
Quote from: cadpoobah on May 06, 2024, 02:28:46 PM
Excellent, Lee. Thanks for sharing.

You're welcome  :-)

Quote from: cadpoobah on May 06, 2024, 02:28:46 PM
Curious, what is the order of the list that (_xrefhierarchy) returns? Is it random based on how tblnext finds the refs?

The order in which they are encountered in the block symbol table, in reverse (though, a simple sort could easily be applied).

Quote from: cadpoobah on May 06, 2024, 02:28:46 PM
Also, does it always list the "deepest" (child) references first, followed by any parent xrefs w child xrefs?

No - the list is merely the order in which they are encountered in the block symbol table; the nesting hierarchy is determined by recursively querying list items with multiple entries against the original list when printing the output.
98
AutoLISP (Vanilla / Visual) / Re: Attribute Text Width
« Last post by HOSNEYALAA on May 07, 2024, 03:44:56 AM »
can you  addition a sample dwg
99
AutoLISP (Vanilla / Visual) / Re: Attribute Text Width
« Last post by MeasureUp on May 07, 2024, 01:58:09 AM »
Thanks.

I was thinking of using "vla-put-textwidth" but didn't figure it out.
Can anyone help?
Thanks again.
100
AutoLISP (Vanilla / Visual) / Re: finding nested xrefs - AutoLISP
« Last post by cadpoobah on May 06, 2024, 02:28:46 PM »
Quote from: Lee Mac on January 24, 2020, 10:39:51 AM
Below is a variation of the code I previously posted here, modified to apply to xrefs only:
Code - Auto/Visual Lisp: [Select]
  1. (defun _nestedxrefs ( blk / enx rtn xrn )
  2.    (while (setq blk (entnext blk))
  3. ...
  4.        (_xrefhierarchy)
  5.    )
  6.    (princ)
  7. )

Excellent, Lee. Thanks for sharing.

Curious, what is the order of the list that (_xrefhierarchy) returns? Is it random based on how tblnext finds the refs? Also, does it always list the "deepest" (child) references first, followed by any parent xrefs w child xrefs?

What I see is something like this:
  (("Child1") ("Child2") ("Childn") ("Parent1" "Child1") ("Parent2" "Child2")...)

Pages: 1 ... 8 9 [10]