Recent Posts

Pages: [1] 2 3 ... 10
1
.NET / Re: Ribbon for ZWCAD
« Last post by It's Alive! on Today at 01:54:50 AM »
I tried to port an AutoCAD plugin to ZWCAD, I gave up after an hour. The ZW .NET API is a thousand paper cuts different. BricsCAD was a walk in the park, as is the ODA .NET Classic library.
Interesting, Not using .NET anymore, but ZW’s C++ API is generally pretty good. 
Did you reach out to them?
2
Thanks, it's solved, I found the error.

ss1 (ssget "f"

ss1 (ssget "_f"
3
.NET / Re: Ribbon for ZWCAD
« Last post by CADbloke on May 05, 2024, 11:10:27 PM »
I tried to port an AutoCAD plugin to ZWCAD, I gave up after an hour. The ZW .NET API is a thousand paper cuts different. BricsCAD was a walk in the park, as is the ODA .NET Classic library.
4
.NET / Re: Beginning to hate WPF Windows almost as much as WinForms!
« Last post by CADbloke on May 05, 2024, 11:05:55 PM »
Quote
Is there a WPF deity I have to worship to get these to show up correctly?
Oh good, it’s not just me. We should start a support group. WPF feels like a survivor story. It’s magic strings and mysteries all the way down. Even ReSharper is often “shrug”.  Your frustration is real.
5
AutoLISP (Vanilla / Visual) / Re: dietpl.lsp - solving endless while loop
« Last post by BIGAL on May 05, 2024, 10:46:07 PM »
Hi marko had a bit of a play and the problem is in this line (setq gg (group_collinear_pts ptlst)) so the function group_collinear never finishes, I tried like (princ (setq x (1+ x)) in the defun and it just went off screen so not sure what number it got to tried adding (if (= x 150)(exit)) to crash it out rather than endless loop. I think its to do with (while ptlst is not ever ending may need a say a check ptlst not sure what it should be then set another variable that is used in (while (= chk "no") etc.

The only way I would find out what is happening is to run the code below the while but knowing how many times I need to run it using copy paste .

Oh yeah may be the problem here (collinear-p a b c)) read as XYZ values but ptlst is only XY there is no Z. You have check X check Y check Z but I dont know what Z is ? NIL 0.0, Just crashed it again, forced to use taskmanager.

6
AutoLISP (Vanilla / Visual) / dietpl.lsp - solving endless while loop
« Last post by ribarm on May 05, 2024, 04:37:47 PM »
I have trouble with this routine I coded recently... This question was asked before, but I and others didn't wanted to answer as question was delicate and by solving result should be very similar to original source entity in question - LWPOLYLINE with / without arced segments...
In attachment is my DWG I quickly created with one of my PLINETOOLS archive and desired solution for this problem is already there., i.e. I created green lwpolyline from white on right side and my goal is that now I am trying to create white from green on the left side... Green lwpolyline has many unnecessary vertices, and so I coded for making diet polyline with only those vertices that are in white lwpolyline... You'll see all in DWG when you download it...
Sadly my code is going in endless (while) loops from 2 sub functions contained in routine named (group_*)...
Can someone try to fix and find where is the problem as I think that those subs are needed for this routine...

Code: [Select]
(defun c:dietpl ( / vertlst bulglst collinear-p group_collinear_pts group_fuzz_pts mid acos tang clockwise-p s fuzz lw ptlst blst assoclst gg g p1 p2 p3 mp1 mp2 c r d ang b nlw lwx )

  (defun vertlst ( lw )
    (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw)))
  )

  (defun bulglst ( lw )
    (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) (entget lw)))
  )

  (defun collinear-p ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (defun group_collinear_pts ( ptlst / a b c g gg )
    (while ptlst
      (setq a (car ptlst) b (cadr ptlst) c (caddr ptlst))
      (while (and c (collinear-p a b c))
        (if (not (vl-position a g))
          (setq g (cons a g))
        )
        (if (not (vl-position b g))
          (setq g (cons b g))
        )
        (if (not (vl-position c g))
          (setq g (cons c g))
        )
        (setq ptlst (cdr ptlst))
      )
      (setq ptlst (cdr ptlst))
      (setq gg (cons (reverse g) gg))
      (setq g nil)
    )
    (reverse gg)
  )

  (defun group_fuzz_pts ( ptlst fuzz / a b g gg )
    (while ptlst
      (setq a (car ptlst) b (cadr ptlst))
      (while (and b (< (distance a b) fuzz))
        (if (not (vl-position a g))
          (setq g (cons a g))
        )
        (if (not (vl-position b g))
          (setq g (cons b g))
        )
        (setq ptlst (cdr ptlst))
      )
      (setq ptlst (cdr ptlst))
      (setq gg (cons (reverse g) gg))
      (setq g nil)
    )
    (reverse gg)
  )

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8) 0.0 )
      ( (equal x -1.0 1e-8) pi )
      ( (and
          (>= x 0.0)
          (equal x 0.0 1e-8)
        )
        (/ pi 2.0)
      )
      ( (and
          (<= x 0.0)
          (equal x -0.0 1e-8)
        )
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (sqrt (- 1.0 (* x x))) x)
      )
    )
  )

  (defun tang ( a )
    (/ (sin a) (cos a))
  )

  (defun clockwise-p ( p1 p p2 )
    (minusp (- (* (car (mapcar (function -) p1 p)) (cadr (mapcar (function -) p2 p))) (* (cadr (mapcar (function -) p1 p)) (car (mapcar (function -) p2 p)))))
  )

  (prompt "\nPick LWPOLYLINE to make it with diet...")
  (if
    (and
      (setq s (ssget "_+.:E:S" (list (cons 0 "LWPOLYLINE"))))
      (not (initget 7))
      (setq fuzz (getdist "\nPick or specify fuzz distance : "))
    )
    (progn
      (setq lw (ssname s 0))
      (setq ptlst (vertlst lw))
      (setq blst (bulglst lw))
      (setq assoclst (mapcar (function (lambda ( p b ) (cons p b))) ptlst blst))
      (setq gg (group_collinear_pts ptlst))
      (foreach g gg
        (setq g (cdr g) g (reverse (cdr (reverse g))))
        (foreach p g
          (setq assoclst (vl-remove-if (function (lambda ( x ) (equal p (car x) 1e-6))) assoclst))
        )
      )
      (setq gg (group_fuzz_pts ptlst fuzz))
      (foreach g gg
        (setq p1 (car g) p2 (cadr g) p3 (last g))
        (setq mp1 (mid p1 p2) mp2 (mid p2 p3))
        (setq c (inters mp1 (polar mp1 (+ (angle p1 p2) (* 0.5 pi)) 1.0) mp2 (polar mp2 (+ (angle p2 p3) (* 0.5 pi)) 1.0) nil))
        (setq r (distance c p1))
        (setq d (distance (mid p1 p3) c))
        (setq ang (* 2.0 (acos (/ d r))))
        (setq b (tang (/ ang 4.0)))
        (if (clockwise-p p1 c p3)
          (setq b (- b))
        )
        (setq assoclst (subst (cons (car g) b) (vl-some (function (lambda ( x ) (if (equal (car x) (car g) 1e-6) x))) assoclst) assoclst))
        (setq g (cdr g) g (reverse (cdr (reverse g))))
        (foreach p g
          (setq assoclst (vl-remove-if (function (lambda ( x ) (equal p (car x) 1e-6))) assoclst))
        )
      )
      (setq nlw
        (entmakex
          (append
            (list
              (cons 0 "LWPOLYLINE")
              (cons 100 "AcDbEntity")
              (cons 100 "AcDbPolyline")
              (cons 90 (length assoclst))
              (assoc 70 (setq lwx (entget lw)))
              (assoc 38 lwx)
            )
            (apply (function append) (mapcar (function (lambda ( p b ) (list (cons 10 p) (cons 42 b)))) (mapcar (function car) assoclst) (mapcar (function cdr) assoclst)))
            (list (assoc 210 lwx))
          )
        )
      )
    )
  )
  (princ)
)

Regards, M.R.
7
I get an error message

Bekomme eine Fehlermeldung

Befehl: XDTB_BRKGAP
Break Gap Distance<3.5>:3
Interruption method [vertical line (0)/horizontal line (1)]<1>1
Select lines to process <Exit>:Entgegengesetzte Ecke angeben: 5 gefunden
Select lines to process <Exit>:
Befehl: AnwendungsFEHLER: SSGET W/C erfordert zwei Punkte
AnwendungsFEHLER: SSGET W/C erfordert zwei Punkte

plz upload dwg
8
AutoLISP (Vanilla / Visual) / Re: Filter list of entities to keep only blocks
« Last post by Red Nova on May 05, 2024, 11:23:06 AM »
thank you ribarm, works well :)
9
I get an error message

Bekomme eine Fehlermeldung

Befehl: XDTB_BRKGAP
Break Gap Distance<3.5>:3
Interruption method [vertical line (0)/horizontal line (1)]<1>1
Select lines to process <Exit>:Entgegengesetzte Ecke angeben: 5 gefunden
Select lines to process <Exit>:
Befehl: AnwendungsFEHLER: SSGET W/C erfordert zwei Punkte
AnwendungsFEHLER: SSGET W/C erfordert zwei Punkte
10
AutoLISP (Vanilla / Visual) / Re: Filter list of entities to keep only blocks
« Last post by ribarm on May 05, 2024, 07:40:53 AM »
Really don't have time now, but try to fix the code you provided... I edited it, but it's totally untested...

Code: [Select]
(defun getnestblkitems ( / sel nfo ent items )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (or cad (setq cad (vlax-get-acad-object)))
  (or doc (setq doc (vla-get-activedocument cad)))
  (or alo (setq alo (vla-get-activelayout doc)))
  (or spc (setq spc (vla-get-block alo)))
  (or blk (setq blk (vla-get-blocks doc)))
  (if
    (and
      (setq sel (entsel "Select a block: "))
      (= (cdr (assoc 0 (setq nfo (entget (car sel))))) "INSERT")
    )
    (vlax-for item (vla-item blk (cdr (assoc 2 nfo)))
      (if (= (cdr (assoc 0 (entget (setq ent (vlax-vla-object->ename item))))) "INSERT")
        (setq items (cons ent items))
      )
    )
    (prompt "\nNo block selected.")
  )
)

Regards...
Pages: [1] 2 3 ... 10