Recent Posts

Pages: [1] 2 3 ... 10
1
AutoLISP (Vanilla / Visual) / Re: Detect autocad express tools installed
« Last post by Marc'Antonio Alessi on Today at 05:26:31 AM »
Quote from: DeeGeeCees_V.2.0 on April 30, 2024, 01:26:50 PM
Quote from: MP on November 02, 2014, 12:07:49 PM
<snipetty snip>

So in the end, my sleep deprived brain thinks the more pragmatic albeit less sexy version merely need be:

Code: [Select]
(defun expresstools-p ( )
    (or
        (member "acetutil.arx" (arx))
        (and (findfile "acetutil.arx") (arxload "acetutil.arx" nil))
    )
)
But mommy, I need coffees. Bad.

I was just passing through to grab this codelette. I miss Mike.
me too  :'(
2
XDRX-API / [XDrX-PlugIn(164)] Smart Centerline
« Last post by xdcad on Today at 03:48:52 AM »

https://www.cadtutor.net/forum/topic/70412-multiple-centerlines-rectangle/

Code: [Select]
(defun c:xdtb_zxx (/ #length _pi2 an box centroid dashlength dist1 dist2 e ep1 ep2 hxl hyl info
                   majoraxis mid1 mid2 minor p p1 p2 p3 p4 pcen pts radius scl sp sp1 sp2 ss temp
                   typ v1 v2 x xl yl
                  )
  (setq _pi2 (/ pi 2))
  (defun mkmark (p an xl yl / hxl hyl p1 p2 p3 p4)
    (setq hxl (* 1.4 xl)
          hyl (* 1.4 yl)
          p1  (polar p an hxl)
          p2  (polar p (+ an pi) hxl)
          p3  (polar p (+ an _pi2) hyl)
          p4  (polar p (- an _pi2) hyl)
    )
    (xdrx_line_make p1 p2)
    (xdrx_setpropertyvalue
      (entlast)
      "layer"
      (xdrx-string-multilanguage "中心线" "CenterLine")
      "linetypescale"
      scl
    )
    (xdrx_line_make p3 p4)
    (xdrx_setpropertyvalue
      (entlast)
      "layer"
      (xdrx-string-multilanguage "中心线" "CenterLine")
      "linetypescale"
      scl
    )
  )
  (defun Polyline_center (e / info pts p1 p2 p3 p4 sp radius)
    (setq info (xdrx_curve_info e)
          pts  (xd::list:removedup (xdrx_getpropertyvalue e "vertices"))
    )
    (cond ((XD::Polyline:IsRectang e)
           (mapcar 'set '(p1 p2 p3 p4) pts)
           (setq dist1 (distance p1 p2)
                 dist2 (distance p2 p3)
                 scl   (/ (* 0.4 (min dist1 dist2)) dashlength)
           )
           (mkmark (cadr (assoc "Centroid" info))
                   (angle p1 p2)
                   (* (distance p1 p2) 0.5)
                   (* (distance p2 p3) 0.5)
           )
          )
          ((XD::Polyline:isRegularPolygon e)
           (setq pcen   (cadr (assoc "Centroid" (xdrx_curve_info e)))
                 sp     (xdrx_curve_getstartpoint e)
                 radius (distance sp pcen)
                 scl    (/ (* 0.8 radius) dashlength)
           )
           (mkmark Pcen (angle pcen sp) radius radius)
          )
          (t (other_center e))
    )
  )
  (defun other_center (e / info centroid box)
    (setq info     (xdrx_curve_info e)
          centroid (cadr (assoc "Centroid" info))
          box      (mapcar 'abs
                           (apply 'mapcar (cons '- (cdr (assoc "Box" info))))
                   )
          scl      (/ (* 0.4 (car box)) dashlength)
    )
    (mkmark centroid 0. (* 0.5 (car box)) (* 0.5 (car box)))
  )
  (defun _istwo (ss)
    (and (xdrx_object_iskindof (ssname ss 0) "LINE")
         (xdrx_object_iskindof (ssname ss 1) "LINE")
    )
  )
  ;;main program
  (if (and (setq ss
  (xdrx_ssget
    (xdrx-string-multilanguage
      "\n选择Line,*Polyline,Arc,Circle,Ellipse,Region<退出>:"
      "\nSelect Line,*Polyline,Arc,Circle,Ellipse,Region<Exit>:"
    )
    '((0 . "line,*polyline,arc,circle,ellipse,region"))
  )
   )
      )
    (progn (xdrx_begin)
           (setq scl 1.0)
           (xdrx_layer_make (xdrx-string-multilanguage "中心线" "CenterLine") 6 "ACAD_ISO10W100")
           (setq dashlength (xdrx_linetype_dashlengthat "ACAD_ISO10W100" 0))
           (if (and (= (sslength ss) 2) (_istwo ss))
             (progn (setq sp1 (xdrx_curve_getstartpoint (ssname ss 0))
                          ep1 (xdrx_curve_getendpoint (ssname ss 0))
                    )
                    (if (< (car ep1) (car sp1))
                      (setq temp ep1
                            ep1  sp1
                            sp1  temp
                      )
                    )
                    (setq v1  (xdrx_vector_normalize (mapcar '- ep1 sp1))
                          sp2 (xdrx_curve_getstartpoint (ssname ss 1))
                          ep2 (xdrx_curve_getendpoint (ssname ss 1))
                    )
                    (if (< (car ep2) (car sp2))
                      (setq temp ep2
                            ep2  sp2
                            sp2  temp
                      )
                    )
                    (setq v2 (xdrx_vector_normalize (mapcar '- ep2 sp2)))
                    (setq mid1 (xdrx_midp sp1 sp2)
                          mid2 (xdrx_midp ep1 ep2)
                    )
                    (xdrx_line_make mid1 mid2)
                    (xdrx_getpropertyvalue (entlast) "length")
                    (setq scl (/ #length 8.0 dashlength))
                    (xdrx_setpropertyvalue
                      (entlast)
                      "layer"
                      (xdrx-string-multilanguage "中心线" "CenterLine")
                      "linetypescale"
                      scl
                    )
             )
             (progn
               (mapcar '(lambda (x / typ radius majoraxis)
                          (setq typ (xdrx_getpropertyvalue x "IsA"))
                          (cond ((wcmatch typ "AcDbCircle,AcDbArc")
                                 (setq radius (xdrx_getpropertyvalue x "Radius")
                                       scl    (/ (* 0.8 radius) 12.0)
                                 )
                                 (mkmark (xdrx_getpropertyvalue x "Center") 0. radius radius)
                                )
                                ((= typ "AcDbEllipse")
                                 (setq majoraxis (xdrx_getpropertyvalue x "MajorAxis")
                                       minor     (xdrx_vector_length (xdrx_getpropertyvalue x "MinorAxis"))
                                       scl       (/ (* 0.8 minor) dashlength)
                                 )
                                 (mkmark (xdrx_getpropertyvalue x "Center")
                                         (angle '(0. 0.) Majoraxis)
                                         (xdrx_vector_length Majoraxis)
                                         minor
                                 )
                                )
                                ((= typ "AcDbPolyline") (polyline_center x))
                                ((not (= typ "AcDbLine")) (other_center x))
                          )
                        )
                       (xdrx_pickset->ents ss)
               )
             )
           )
           (xdrx_end)
    )
  )
  (princ)
)
3
XDRX-API / [XDrX-PlugIn(163)] Dynamically display the area ect.. information of rectange
« Last post by xdcad on Today at 03:15:17 AM »
https://www.cadtutor.net/forum/topic/70763-display-the-area-by-picking-rectangle/

Code: [Select]
(defun c:xdtb_dynrecarea (/ #mcolor cen data dynpt height lastpnt mArea nums
    p-1 p2 p-2 pn1 pt1 pt2 pts str txt wid
)
  (defun _callback (dynpt)
    (if (not (and
       (equal pn1 dynpt 1e-3)
       (equal lastpnt dynpt 1e-3)
     )
)
      (progn
(setq lastpnt dynpt
      pt2 (xdrx-getpropertyvalue (list pn1 p-2) "getclosestpointto"
dynpt t
  )
)
(setq pt1 (xdrx-getpropertyvalue (list pn1 p-1) "getclosestpointto"
dynpt t
  )
      wid (distance pt2 dynpt)
      height (distance pt1 dynpt)
      pts (list pt2 dynpt pt1 pn1)
      cen (xdrx-line-midp dynpt pn1)
      mArea (* wid height)

      nums (length data)
      str (xdrx-string-formatex (xdrx-string-multilanguage "宽度= %.1f\r\n高度= %.1f\r\n面积=%.1f" "Width= %.1f\r\nHeight= %.1f\r\nArea=%.1f")
wid height mArea
  )
)
(xd::grdraw:drawtext txt str cen 5 (* (getvar "viewsize") 0.025) 2
     (getvar "ucsxdir") nil 8
)
      )
    )
    str
  )
  (xdrx-begin)
  (xdrx-sysvar-push '("osmode" 8))
  (if (setq pn1 (getpoint (xdrx-string-multilanguage "\n矩形起始点<退出>:" "\nRect Start Point<Exit>:")))
    (progn
      (setq #mcolor 1)
      (setq p-1 (mapcar
  '+
  pn1
  '(1 0 0)
)
    p-2 (mapcar
  '-
  pn1
  '(0 1 0)
)
    txt (xdrx-mtext-make)
      )
      (XD::Drag:CallBackSetMouseMove "_callback")
      (if (setq p2 (xd::doc:getcorner pn1
      (xdrx-string-multilanguage "\n对角点<退出>:" "\ndiagonal point<Exit>:")
      #mcolor '(1 0 0)
   )
  )
(progn
  (xdrx-polyline-make pts t)
  (xdrx-setpropertyvalue (entlast) "color" #mcolor)
  (xdrx-prompt (strcat "\n" str))
)
      )
      (xdrx-pointmonitor)
    )
  )
  (xdrx-end)
  (princ)
)
4
AutoLISP (Vanilla / Visual) / Re: [request] Radiant Pipe Layout
« Last post by ribarm on May 03, 2024, 07:00:13 PM »
Here is another pattern...
With this code - CAD will construct double heating pipes with required distance from left edge so that pipes can return to base heating instalation... But this pattern is only single row, so you should copy rows by 4 x distance upward... Then you could use stretching, exploding last row and make bigger fillets so that you can pass through leaving pipes into instalation...

Here is the code :
Code - Auto/Visual Lisp: [Select]
  1. (defun c:heating-pipes ( / *error* chiv inside-p cmd osm s lw pt d1 d2 mf dd vl vx bl pl )
  2.  
  4.  
  5.   (defun *error* ( m )
  6.     (if cmd
  7.       (setvar (quote cmdecho) cmd)
  8.     )
  9.     (if osm
  10.       (setvar (quote osmode) osm)
  11.     )
  12.     (if m
  13.       (prompt m)
  14.     )
  15.     (princ)
  16.   )
  17.  
  18.   (defun chiv ( pl pt / pp ptt bulge )
  19.  
  20.     (defun pp ( pl p / par )
  21.       (if (setq par (rem (- (fix (vlax-curve-getparamatpoint pl (trans p 1 0))) 0.5) (vlax-curve-getendparam pl)))
  22.         (list
  23.           (trans (vlax-curve-getpointatparam pl (rem (- par 0.1) (vlax-curve-getendparam pl))) 0 1)
  24.           (trans (vlax-curve-getpointatparam pl (rem (+ par 0.1) (vlax-curve-getendparam pl))) 0 1)
  25.         )
  26.       )
  27.     )
  28.  
  30.       (progn
  31.         (setq pt
  32.           (trans
  33.             (vlax-curve-getpointatparam pl
  34.               (rem (float (fix (+ 0.5 (vlax-curve-getparamatpoint pl (setq p1 (vlax-curve-getclosestpointto pl (trans pt 1 0))))))) (vlax-curve-getendparam pl))
  35.             )
  36.             0 1
  37.           )
  38.         )
  39.         (setq p (pp pl pt))
  40.         (if (vlax-method-applicable-p (vlax-ename->vla-object pl) 'getbulge)
  41.           (setq bulge (vla-getbulge (vlax-ename->vla-object pl) (fix (vlax-curve-getparamatpoint pl (trans (car p) 1 0)))))
  42.         )
  43.         (if command-s
  44.           (command-s "_.BREAK" pl "_non" (car p) "_non" (cadr p))
  45.           (vl-cmdf "_.BREAK" pl "_non" (car p) "_non" (cadr p))
  46.         )
  47.         (if command-s
  48.           (command-s "_.TRIM" pl "" "_non" (trans (vlax-curve-getpointatparam pl 0.1) 0 1) "_non" (trans (vlax-curve-getpointatparam pl (- (vlax-curve-getendparam pl) 0.1)) 0 1) "")
  49.           (vl-cmdf "_.TRIM" pl "" "_non" (trans (vlax-curve-getpointatparam pl 0.1) 0 1) "_non" (trans (vlax-curve-getpointatparam pl (- (vlax-curve-getendparam pl) 0.1)) 0 1) "")
  50.         )
  51.         (if (not (equal pt (trans (vlax-curve-getstartpoint pl) 0 1) 1e-6))
  52.           (progn
  53.             (if command-s
  54.               (command-s "_.PEDIT" pl "" "_R")
  55.               (vl-cmdf "_.PEDIT" pl "" "_R")
  56.             )
  57.             (while (< 0 (getvar (quote cmdactive)))
  58.               (vl-cmdf "")
  59.             )
  60.           )
  61.         )
  62.         (vla-put-closed (vlax-ename->vla-object pl) :vlax-true)
  63.         (if (vlax-method-applicable-p (vlax-ename->vla-object pl) 'getbulge)
  64.           (vla-setbulge (vlax-ename->vla-object pl) (1- (vlax-curve-getendparam pl)) bulge)
  65.         )
  66.       )
  67.       (prompt "\n(chiv) sub function works only on closed POLYLINE entity...")
  68.     )
  69.   )
  70.  
  71.   (defun inside-p ( lw p / lwi r )
  72.     (vla-offset (vlax-ename->vla-object lw) -1e-3)
  74.       (setq lwi (entlast))
  75.       (progn
  76.         (entdel (entlast))
  77.         (vla-offset (vlax-ename->vla-object lw) 1e-3)
  78.         (setq lwi (entlast))
  79.       )
  80.     )
  82.       (setq r t)
  83.     )
  84.     (entdel lwi)
  85.     r
  86.   )
  87.  
  88.   (setq cmd (getvar (quote cmdecho)))
  89.   (setvar (quote cmdecho) 0)
  90.   (setq osm (getvar (quote osmode)))
  91.   (setvar (quote osmode) 0)
  92.   (prompt "\nPick closed polygonal LWPOLYLINE on unlocked Layer...")
  93.   (if (setq s (ssget "_+.:E:S:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons 410 (if (= 1 (getvar (quote cvport))) "Model" (getvar (quote ctab)))))))
  94.     (progn
  95.       (setq lw (ssname s 0))
  96.       (setvar (quote osmode) 1)
  97.       (initget 1)
  98.       (setq pt (getpoint "\nPick or specify lower-left starting/ending vertex of picked LWPOLYLINE : "))
  99.       (setvar (quote osmode) 0)
  100.       (if (not (equal pt (trans (vlax-curve-getstartpoint lw) 0 1) 1e-6))
  101.         (chiv lw pt)
  102.       )
  103.       (setq d1 (distance pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)))
  104.       (setq d2 (distance pt (trans (vlax-curve-getpointatparam lw (float (fix (1- (+ (vlax-curve-getendparam lw) 0.1))))) 0 1)))
  105.       (if (< d1 d2)
  106.         (progn
  107.           (if command-s
  108.             (command-s "_.PEDIT" lw "" "_R")
  109.             (vl-cmdf "_.PEDIT" lw "" "_R")
  110.           )
  111.           (while (< 0 (getvar (quote cmdactive)))
  112.             (vl-cmdf "")
  113.           )
  114.         )
  115.       )
  116.       (initget 7)
  117.       (setq dd (getdist "\nPick or specify offset distance from shorter side of polygon edge : "))
  118.       (setq vl (cons (polar pt (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (* 4.0 dd)) vl))
  119.       (setq vl (cons (polar (polar (car vl) (+ (* 0.5 pi) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1))) (* 0.5 dd)) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (* 0.5 dd)) vl))
  120.       (setq vx (inters (car vl) (polar (car vl) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) 1.0) (trans (vlax-curve-getpointatparam lw 1.0) 0 1) (trans (vlax-curve-getpointatparam lw 2.0) 0 1) nil))
  121.       (setq vl (cons (polar vx (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (- (* 2.5 dd))) vl))
  122.       (setq vl (cons (polar (polar (car vl) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (* 1.5 dd)) (+ (* 0.5 pi) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1))) (* 1.5 dd)) vl))
  123.       (setq vl (cons (polar (polar (car vl) (+ (* 0.5 pi) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1))) (* 1.5 dd)) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (- (* 1.5 dd))) vl))
  125.       (setq vl (cons (polar vx (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (* 4.5 dd)) vl))
  126.       (setq vl (cons (polar (polar (car vl) (+ (* 0.5 pi) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1))) (* 0.5 dd)) (angle pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1)) (- (* 0.5 dd))) vl))
  127.       (setq bl (cons (- (1- (sqrt 2.0))) bl))
  128.       (setq bl (cons 0.0 bl))
  129.       (setq bl (cons (1- (sqrt 2.0)) bl))
  130.       (setq bl (cons (1- (sqrt 2.0)) bl))
  131.       (setq bl (cons 0.0 bl))
  132.       (setq bl (cons (- (1- (sqrt 2.0))) bl))
  133.       (setq bl (cons (- (1- (sqrt 2.0))) bl))
  134.       (setq vl (reverse vl))
  135.       (setq bl (reverse bl))
  136.       (setq pl
  137.         (entmakex
  138.           (append
  139.             (list
  140.               (cons 0 "LWPOLYLINE")
  141.               (cons 100 "AcDbEntity")
  142.               (cons 100 "AcDbPolyline")
  143.               (cons 90 (length vl))
  144.               (cons 70 (* 128 (getvar (quote plinegen))))
  145.               (cons 38 0.0)
  146.             )
  147.             (apply (function append) (mapcar (function (lambda ( p b ) (list (cons 10 p) (cons 42 b)))) vl bl))
  148.             (list (list 210 0.0 0.0 1.0))
  149.           )
  150.         )
  151.       )
  152.       (vla-offset (vlax-ename->vla-object pl) (- dd))
  153.       (if (not (inside-p lw (last vl)))
  154.         (if command-s
  155.           (command-s "_.MIRROR" (ssadd pl (ssadd (entlast))) "" pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1) "_Y")
  156.           (vl-cmdf "_.MIRROR" (ssadd pl (ssadd (entlast))) "" pt (trans (vlax-curve-getpointatparam lw 1.0) 0 1) "_Y")
  157.         )
  158.       )
  159.     )
  160.   )
  161.   (*error* nil)
  162. )
  163.  
5
AutoLISP (Vanilla / Visual) / Re: "ssget everything" for a single point?
« Last post by kdub_nz on May 03, 2024, 06:37:44 PM »
I can relate to this :
Quote
perfectionist trapped inside the mind of an idiot.
6
AutoLISP (Vanilla / Visual) / Re: "ssget everything" for a single point?
« Last post by JasonB on May 03, 2024, 05:42:14 PM »
You mentioned in your original post that you were looking mainly for solid hatches. You could refine your SSGET call to limit its selection to just the entities that you seek.

e.g.
changing
Code - Auto/Visual Lisp: [Select]
  1. (setq nadel_aws (ssget "_C" ro lu))

to

Code - Auto/Visual Lisp: [Select]
  1. (setq nadel_aws (ssget "_C" ro lu '((0 . "HATCH")(2 . "SOLID"))))
will only allow selection of hatches with solid fill.

Filtering the selection set to just what you want makes the code following easier as you know what entities are in the selection set.
7
XDRX-API / [XDrX-PlugIn(162)] Break horizontal or vertical lines according to spacing
« Last post by xdcad on May 03, 2024, 04:50:36 PM »
A friend sent a request：

http://bbs.xdcad.net/thread-730113-1-1.html

1. Only process horizontal or vertical lines
2. Only break unclosed lines or polylines, and do not process closed curves encountered.
3. Only break the cross point out

Code: [Select]
(defun c:xdtb_brkgap ( / verts1 an ent ints mode p1 p2 ss ss1 vec verts x y)
  (defun _break-line (ent an)
    (if (and (setq
       ss1 (ssget "f"
  verts
  '((0 . "*polyline,line")
    (-4 . "<not")
    (-4 . "&=")
    (70 . 1)
    (-4 . "not>")
   )
   )
     )
     (progn
       (ssdel x ss1)
       t
     )
     (> (sslength ss1) 0)
)
      (progn
(mapcar '(lambda (x)
   (setq verts1 (xdrx-getpropertyvalue x "vertices"))
   (if (and (setq ints (xdrx-get-inters ent x))
    (setq ints (vl-remove-if
'(lambda (y)
    (or (member y verts1)
(member y verts))
  )
ints
       )
    )
    (> (length ints) 0)
       )
     (progn
       (setq ints
  (xdrx-points-sortoncurve ent ints)
     ints (mapcar 'car ints)
       )
       (mapcar '(lambda (y)
  (setq p1 (polar
     y
     an
     (/
       #xd-var-global-break-gap-distance
       2.0
     )
   )
p2 (polar
     y
     (+ an pi)
     (/
       #xd-var-global-break-gap-distance
       2.0
     )
   )
  )
  (xdrx-curve-break ent p1 p2)
  (setq ent (entlast))
)
       ints
       )
     )
   )
)
(xdrx-ss->ents ss1)
)
      )
    )
  )
  (xdrx-begin)
  (xd::doc:getdouble
    (xdrx-string-multilanguage
      "\n打断距离"
      "\nBreak Gap Distance"
    )
    "#xd-var-global-break-gap-distance"
    3.5
  )
  (if (not #xd-var-global-slope-mode)
    (setq #xd-var-global-slope-mode "0")
  )
  (xdrx-initget 0 "0 1")
  (if (setq mode
     (getkword
       (xdrx-string-formatex
(xdrx-string-multilanguage
   "\n打断方式[竖线(0)/水平线(1)]<%s>"
   "\nInterruption method [vertical line (0)/horizontal line (1)]<%s>"
)
#xd-var-global-slope-mode
       )
     )
      )
    (setq #xd-var-global-slope-mode mode)
  )
  (if (setq ss (xdrx-ssget
(xdrx-string-multilanguage
   "\n选择要处理的线<退出>:"
   "\nSelect lines to process <Exit>:"
)
'((0 . "*polyline,line")
   (-4 . "<not")
   (-4 . "&=")
   (70 . 1)
   (-4 . "not>")
  )
       )
      )
    (progn
      (xdrx-begin)
      (xdrx-document-safezoom ss)
      (mapcar '(lambda (x)
(if (or (xdrx-object-iskindof x "line")
(and (xdrx-object-iskindof x "*polyline")
      (= (xdrx-getpropertyvalue x "numverts") 2)
      (xdrx-polyline-isonlylines x)
)
     )
   (progn
     (setq verts (xdrx-getpropertyvalue x "vertices")
   vec (xdrx-vector-normalize
   (mapcar '- (last verts) (car verts))
)
     )
     (if (= #xd-var-global-slope-mode "0")
       (progn
(if (xdrx-vector-isparallelto '(0 1 0) vec)
   (_break-line x (/ pi 2.0))
)
       )
       (progn
(if (xdrx-vector-isparallelto '(1 0 0) vec)
   (_break-line x 0.0)
)
       )
     )
   )
)
       )
      (xdrx-ss->ents ss)
      )
      (xdrx-end)
    )
  )
  (princ)
)
8
AutoLISP (Vanilla / Visual) / Re: "ssget everything" for a single point?
« Last post by Peter2 on May 03, 2024, 09:32:02 AM »
Hi
thanks to all for the contributions. I made now a small code (coarse as usually) with works with a fixed "cross select box" around the cursor, displayed with grvecs. No error routine, no dynamic settings, tons of varibles  and so on, but basically it seem to work - but selecting big hatches stays a challenge.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:nadelwahl ( / osmode_alt trackflag trackdata trackpoint lu lo ro ru nadel_aws)
  2.     (princ "\nPunkt klicken zur Nadelauswahl: ")
  3.     (setq osmode_alt (getvar "osmode"))
  4.     (setvar "osmode" 0)
  5.     (setq trackflag nil)
  6.     (while (not trackflag)
  7.         (setq trackdata (grread T) trackpoint (cadr trackdata))
  8.         (cond  
  9.             ((= (car trackdata) 3)      ; Punkt geklickt - speichern
  10.                 (setq trackflag T)
  11.                 (redraw)
  12.             )
  13.             ((= (car trackdata) 5)      ; Kreuz bewegt - zeichnen
  14.                 (setq lu (polar trackpoint (* 1.25 pi) 1.4)
  15.                       lo (polar trackpoint (* 0.75 pi) 1.4)
  16.                       ro (polar trackpoint (* 0.25 pi) 1.4)
  17.                       ru (polar trackpoint (* 1.75 pi) 1.4)
  18.                 )
  19.                 (redraw)
  20.                 (grvecs (list 6 lu lo lo ro ro ru ru lu lu ro lo ru))
  21.             )
  22.         )
  23.     )
  24.     (if trackpoint
  25.         (progn
  26.             (setq nadel_aws (ssget "_C" ro lu))
  27.             (if nadel_aws
  28.                 (progn
  29.                     (princ (strcat "\nGewählt: " (itoa (sslength nadel_aws)) " Element(e)."))
  30.                     (sssetfirst nadel_aws nadel_aws)
  31.                 )
  32.                 (princ (strcat "\nGewählt: 0 Elemente."))
  33.             )
  34.         )
  35.     )
  36.     (setvar "OSMODE" osmode_alt)
  37.     (princ)
  38. )
  40.  
9
XDRX-API / [XDrX-PlugIn(161)] Label Rectangle
« Last post by xdcad on May 03, 2024, 07:52:09 AM »
https://www.cadtutor.net/forum/topic/64709-label-rectangle/

1. Eliminate unnecessary vertices
2. Modify the starting point to the lower left point (X is the smallest and Y is the smallest), and the clockwise direction is counterclockwise.
3. Align the text on the long side, and mark the text on the horizontal side first.

Code: [Select]
(defun c:xdtb_reclabel (/ cen centroid label minpt pts ss txt x xdir)
  (xd::doc:getdouble (xdrx-string-multilanguage "\n文字高度" "\nText Height")
     "#xd-var-global-text-height" 3.5
  )
  (xd::doc:getint (xdrx-string-multilanguage "\n小数位数" "\ndecimal places")
  "#xd-var-global-num-bits" 1
  )
  (if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择矩形<退出>:" "\nSelect Rectangle<Exit>:")
   '((0 . "*polyline"))
       )
      )
    (progn
      (xdrx-begin)
      (mapcar
'(lambda (x)
   (if (xd::polyline:isrectang x)
     (progn
       (xdrx-polyline-compress x)
       (setq pts (xdrx-getpropertyvalue x "vertices")
     minpt (xd::pnts:minx->miny pts 1e-5)
     minpt (car minpt)
       )
       (xdrx-curve-setclosed x)
       (xdrx-polyline-resetstartpoint x minpt)
       (setq pts (xdrx-getpropertyvalue x "vertices")
     xdir (xdrx-vector-normalize (mapcar
   '-
   (nth 1 pts)
   (nth 0 pts)
)
  )
       )
       (if (< (distance (nth 1 pts) (nth 0 pts)) (distance
   (nth 1
pts
   )
   (nth 2
pts
   )
)
   )
(setq xdir (xdrx-vector-normalize (mapcar
     '-
     (nth 2 pts)
     (nth 1 pts)
   )
    )
)
       )
       (setq label (strcat (rtos (distance (car pts) (cadr pts)) 2
#xd-var-global-num-bits
   ) "x" (rtos (distance (cadr pts)
(caddr pts)
       ) 2 #xd-var-global-num-bits
)
   )
       )
       (setq centroid (xdrx-getpropertyvalue x "centroid"))
       (setq txt (xdrx-text-make centroid label
#xd-var-global-text-height
)
     cen (xdrx-getpropertyvalue txt "centroid")
       )
       (xdrx-entity-align txt cen '(1 0 0) centroid xdir)
       (xd::text:adjust txt)
       (xdrx-setpropertyvalue txt "horizontalmode" 1 "verticalmode"
      2 "alignmentpoint" centroid "color" 1
       )
     )
   )
)
(xdrx-ss->ents ss)
      )
      (xdrx-end)
    )
  )
  (princ)
)
10
AutoLISP (Vanilla / Visual) / Re: copy+rename block definition
« Last post by rayakmal on May 03, 2024, 02:40:02 AM »
Your code works great, I wish it has choices to copy the definition and set its insertion unit to "0" (Unitless). Context: Drawing came from other department and all block are in 'meter' and I want its insertion scale is unitless.

I already set this variables:
 
(setvar  "INSUNITSDEFTARGET" 0)
(setvar  "INSUNITSDEFSOURCE" 0)
(command "insunits" 0)

Still the block's insertion units in 'Meter'.
 
Is it possible to work around this problem?

Quote from: Lee Mac on June 24, 2019, 12:42:54 PM
Quote from: HasanCAD on June 24, 2019, 10:20:02 AM
Quote from: ribarm on June 24, 2019, 10:04:54 AM
Quote from: ribarm on June 24, 2019, 09:37:10 AM
Just haven't checked if all linked data is preserved...

Just checked, both methods are fine in preseving linked data... Perfect, thanks Lee and Hasan...

All Appreciation to LEE I am just Links index.

Thanks both.  :-)
Pages: [1] 2 3 ... 10