Recent Posts

Pages: [1] 2 3 ... 10
1
AutoLISP (Vanilla / Visual) / Re: Find and fix polylines with only one vertex (Acad 2008)
« Last post by PKENEWELL on Today at 03:18:23 PM »
Try running the following routine in the drawing. Let me know if this solves the issue. EDIT. Forgot to add the (pjk-Massoc) routine - corrected.

Code: [Select]
(defun c:NULLP ( / bad cnt el en et fuzz pel pen pl ss tcnt)
   (setq cnt 0 tcnt 0 fuzz 1e-11)
   (princ "\n\nSearching Zero Length Polylines...")
   (if (setq ss (ssget "X" (list (cons 0 "*POLYLINE"))))
      (repeat (sslength ss)
         (setq en (ssname ss cnt) el (entget en) et (cdr (assoc 0 el)) cnt (1+ cnt) bad nil)
         (cond
            ((= et "LWPOLYLINE")
               (setq pl  (mapcar 'cdr (pjk-Massoc el 10))
                     f   (car pl)
                     bad (or (= (length pl) 1)(apply '= (mapcar (function (lambda (x)(equal x f fuzz))) pl)))
               )
            )
            ((= et "POLYLINE")
               (setq pen (entnext en))
               (while (and pen (= (cdr (assoc 0 (setq pel (entget pen)))) "VERTEX"))
                  (setq pl  (reverse (cons (cdr (assoc 10 pel)) (reverse pl)))
                        pen (entnext pen)
                  )
               )
               (setq f   (car pl)
                     bad (or (= (length pl) 1)(apply '= (mapcar (function (lambda (x)(equal x f fuzz))) pl)))
               )
            )
         )
         (if bad (progn (entdel en)(setq tcnt (1+ tcnt))))
      )
   )
   (princ (strcat "\nRemoved (" (itoa tcnt) ") Zero Length Polylines"))
   (princ)
)

(defun pjk-Massoc (el dxf)
   (vl-remove-if 'null
      (mapcar (function (lambda (x)(if (= (car x) dxf) x nil))) el)
   )
)
2
AutoLISP (Vanilla / Visual) / Re: Link DCL with lisp
« Last post by Topographer on Today at 12:24:52 PM »
is it possible to use a dcl file and not another lisp to do this?
3
AutoLISP (Vanilla / Visual) / Re: help with area lisp
« Last post by Topographer on Today at 12:19:22 PM »
any other options?

Thanks
4
CAD General / Move VP area in model
« Last post by HasanCAD on Today at 11:55:46 AM »
Hi All,

I am attaching PDFs to DWG and want to view each one in a separate layout as attached.
Distance in Model between each PDF is 1
Offset in VP is 370

I am wondering is there a way to move the viewport fir that distance ?

5
AutoLISP (Vanilla / Visual) / Re: help with area lisp
« Last post by ribarm on Today at 10:19:06 AM »
Just a note for my posted code... Area you pick with a point will be calculated for enclosing curves that are only on unlocked layer(s) - those on locked layer(s) will be omitted in boundary calculation...
6
AutoLISP (Vanilla / Visual) / Re: help with area lisp
« Last post by Topographer on Today at 10:09:37 AM »
Nice code ribam but is not workin for my job. I have polygons with fence inside and buildings and roads. I need to select the close polyline not to pick inside becouse gives me wrong results
7
AutoLISP (Vanilla / Visual) / Re: help with area lisp
« Last post by ribarm on Today at 10:01:56 AM »
I've pulled out this one from my library for quick area placements directly inside enclosed boundary of ACAD curve entities...
Maybe someone can improve it further more...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:aaa ( / *error* ss-allcurves mk_txt p ar el )
  2.  
  4.  
  5.   (defun *error* ( m / ch )
  6.     (initget "Yes No")
  7.     (setq ch (getkword "\nDo you want to keep *size* variable for text size in memory or not [Yes/No] <Yes> : "))
  8.     (if (null ch)
  9.       (setq ch "Yes")
  10.     )
  11.     (if (= ch "No")
  12.       (setq *size* nil)
  13.     )
  14.     (if m
  15.       (prompt m)
  16.     )
  17.     (princ)
  18.   )
  19.  
  20.   (defun ss-allcurves ( / ss sss ssss i e )
  21.     (if (not (equal '(nil nil) (sssetfirst nil (ssget "_A" (list (cons 0 "*POLYLINE,SPLINE,XLINE,LINE,RAY,ARC,CIRCLE,ELLIPSE,HELIX") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))))))) (setq ss (ssget "_:L")))
  22.     (setq sss (ssadd))
  23.     (if ss
  24.       (repeat (setq i (sslength ss))
  25.         (setq e (ssname ss (setq i (1- i))))
  26.         (if (not (minusp (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget e))))))))
  27.           (ssadd e sss)
  28.         )
  29.       )
  30.     )
  31.     (setq ssss (ssadd))
  32.     (if sss
  33.       (repeat (setq i (sslength sss))
  34.         (setq e (ssname sss (setq i (1- i))))
  35.         (if (zerop (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))))
  36.           (ssadd e ssss)
  37.         )
  38.       )
  39.     )
  40.     (if ssss
  41.       (if (/= (sslength ssss) 0)
  42.         ssss
  43.         nil
  44.       )
  45.       nil
  46.     )
  47.   )
  48.  
  49.   (defun mk_txt ( p txt a )
  50.     (or *size* (setq *size* (getvar 'textsize)))
  51.     (entmake
  52.       (list
  53.         '(0 . "TEXT")
  54.         '(100 . "AcDbEntity")
  55.         '(100 . "AcDbText")
  56.         '(7 . "Standard")
  57.         (cons 1 txt)
  58.         (cons 10 p)
  59.         (cons 40 *size*)
  60.         (cons 50 a)
  61.         '(71 . 0)
  62.         '(72 . 1)
  63.         (cons 11 p)
  64.         '(210 0.0 0.0 1.0)
  65.         '(73 . 2)
  66.       )
  67.     )
  68.   )
  69.  
  70.   (setq *size* (if (null *size*) (progn (initget 6) (getdist (strcat "\nPick or specify textsize <" (if (zerop (vla-get-height (vla-get-activetextstyle (vla-get-activedocument (vlax-get-acad-object))))) (rtos (* (/ (getvar 'viewsize) (cadr (getvar 'screensize))) 10) 2 50) (rtos (getvar 'textsize) 2 50)) "> : "))) *size*))
  71.   (if (null *size*)
  72.     (setq *size*
  74.         (* (/ (getvar 'viewsize) (cadr (getvar 'screensize))) 10)
  75.         (getvar 'textsize)
  76.       )
  77.     )
  78.   )
  79.   (while (setq p (getpoint "\nPick or specify point inside boundary : "))
  80.     (setq el (entlast))
  81.     (vl-cmdf "_.-BOUNDARY" "_A" "_O" "_R" "_I" "_N" "_N" "_B" "_N" (ss-allcurves) "" "" "_non" p "")
  82.     (if (not (eq el (entlast)))
  83.       (progn
  84.         (setq ar (vla-get-area (vlax-ename->vla-object (entlast))))
  85.         (entdel (entlast))
  86.         (mk_txt p (rtos ar 2 4) 0.0)
  87.       )
  88.     )
  89.   )
  90.   (*error* nil)
  91. )
  92.  

HTH., M.R.
8
AutoLISP (Vanilla / Visual) / Re: help with area lisp
« Last post by tombu on Today at 07:41:20 AM »
I prefer using the fields approach since objects whose areas have been modified would reflect the updated area in the field.
Lee Mac has several that are close to what you're describing.  I like the idea of preventing an object from being selected more than once.  Being able to subtract areas would be nice as well. http://lee-mac.com/areastofield.html
His Field Arithmetic lisp could help with that.

Irné Barnard has another: https://forums.augi.com/showthread.php?98524-Area-of-Hatched-Objects&p=967005&viewfull=1#post967005
9
AutoLISP (Vanilla / Visual) / Re: Link DCL with lisp
« Last post by Topographer on Today at 06:05:07 AM »
any iidea ?


Thanks
10
AutoLISP (Vanilla / Visual) / help with area lisp
« Last post by Topographer on Today at 05:54:45 AM »
Hi i use thi lisp to calculate area of a polyline and insert area text in the drawing. This code allow me to select multyple polylines and calculate the area. I want to add an option

for example

1. Select one polyline only
2. Select multyple polylines

or if i pick twice the same polyline gines me an alert window  to select (yes or no if i accept to continue)

I want this option because is easy to do a mistake and pick two times the same polyline and take the double area .

Code - Auto/Visual Lisp: [Select]
  1. (defun C:GetArea (/ ent myArea pt1 ht scl )
  2. (COMMAND "_layer" "_m" "Area" "_c" "6""" "")
  3. (command "-style" "Area" "arial.ttf" "" "" "" "" "")
  4. (setq scl (getvar "useri1"))
  5.  (setq ht(* 0.003 scl))
  6.   ;turn off the system echo
  7.   (setvar "cmdecho" 0)
  8.   ;set up a variable to hold the accumulated areas
  9.   (setq myArea 0)
  10.   ;while the user keeps making a selection
  11.   (while(setq ent(entsel))
  12.     ;if an entity was selected and not a point in space    
  13.     (if(car ent)
  14.        (progn
  15.           ;let AutoCAD get the area of the object...cheap yet effective way out...
  16.           ;Note: AutoCAD stores the area in the system variable "Area"
  17.           (command "area" "Object" (car ent))
  18.           ;print the area to the command line
  19.           (princ (strcat "\n E = " (rtos (getvar "Area") 2 2)" sq.m"))
  20.           ;accumulate the area if it exist
  21.           (if (getvar "Area")(setq myArea(+ myArea (getvar "Area"))))
  22.        )
  23.     )
  24.   )
  25.   ;ask for a text insertion point
  26.   (setq pt1 (getpoint "\n Insert text:"))
  27.   ;print the area in the drawing
  28.   (command "text" pt1 ht 100 (strcat "E = "(rtos myArea 2 2)" &#964;.&#956;"))
  29.  
  30.   ;suppress the last echo
  31.  (command "setvar" "clayer" "0")
  32.   (princ)
  33. )
  34.  
  35.  

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