Recent Posts

Pages: 1 [2] 3 4 ... 10
11
.NET / Re: Question about the parameters of database's constructor.
« Last post by Ekob on July 04, 2022, 05:35:58 AM »
Thanks for clarifying it. I was struggling to understand what buildDefaultDrawing means and how to connect it with parameter noDocument.
Since I started to do business, the worst parts are keeping and updating the CRM with relevant information. Clients come and go, and storing information about them is crucial for the eventual development of the company. Lead data enrichment is one of the most useful tools that generates permanent sales in the company.
12
AutoLISP (Vanilla / Visual) / copy and paste multiple
« Last post by andi.lad2909 on July 04, 2022, 03:43:00 AM »
Hello everyone.

I am a new member of this group. Trying to find a lisp code to select the object and then paste it in left and right both direction at given specified distance and given specified times. Please refer attached CAD file for problem statement.
13
AutoLISP (Vanilla / Visual) / Re: How to draw?
« Last post by Lee Mac on July 03, 2022, 06:53:06 PM »
I would suggest something like this:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:cl ( / i l s x )
  2.     (if (setq s (ssget '((0 . "LINE"))))
  3.         (progn
  4.             (repeat (setq i (sslength s))
  5.                 (setq i (1- i)
  6.                       x (entget (ssname s i))
  7.                       l (vl-list* (cdr (assoc 10 x)) (cdr (assoc 11 x)) l)
  8.                 )
  9.             )
  10.             (setq l (mapcar '(lambda ( x ) (apply 'mapcar (cons x l))) '(min max)))
  11.             (entmake
  12.                 (list
  13.                    '(0 . "LINE")
  14.                     (list 10 (caar  l) (/ (+ (cadar l) (cadadr l)) 2.0))
  15.                     (list 11 (caadr l) (/ (+ (cadar l) (cadadr l)) 2.0))
  16.                 )
  17.             )
  18.             (entmake
  19.                 (list
  20.                    '(0 . "LINE")
  21.                     (list 10 (/ (+ (caar l) (caadr l)) 2.0) (cadar  l))
  22.                     (list 11 (/ (+ (caar l) (caadr l)) 2.0) (cadadr l))
  23.                 )
  24.             )
  25.         )
  26.     )
  27.     (princ)
  28. )
14
AutoLISP (Vanilla / Visual) / angle fix code problem
« Last post by dussla on July 03, 2022, 01:15:48 PM »
this code is  rectify code
Using lots of great friends code, I ended up with the following code:
but there is problem

0 ,enter   rg9 command
1. select objects
2. enter 45 angel

if i   1 object  select ,  work  some  good  result

but tow error
    a.   mulit select object error   
    b, duplicated object

i  seek  error for a long time, but my limit
pls help again

Code: [Select]





;; Outline Objects  -  Lee Mac
;; Attempts to generate a polyline outlining the selected objects.
;; sel - [sel] Selection Set to outline
;; Returns: [sel] A selection set of all objects created

(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp )
(setq cl (getvar "clayer"))
(command "-Layer" "m" "_boe"  "c" "32" "_boe" "")

(command "-layer" "s" "_boe" "")
       
    (if (setq box (LM:ssboundingbox sel))
        (progn
            (setq app (vlax-get-acad-object)
                  dis (/ (apply 'distance box) 20.0)
                  lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
                  are (apply '* (apply 'mapcar (cons '- (reverse lst))))
                  dis (* dis 1.5)
                  ent
                (entmakex
                    (append
                       '(   (000 . "LWPOLYLINE")
                            (100 . "AcDbEntity")
                            (100 . "AcDbPolyline")

                            (090 . 4)
                            (070 . 1)
                        )
                        (mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
                           '(   (caar   cadar)
                                (caadr  cadar)
                                (caadr cadadr)
                                (caar  cadadr)
                            )
                        )
                    )
                )
            )
            (apply 'vlax-invoke
                (vl-list* app 'zoomwindow
                    (mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))
                )
            )
            (setq cmd (getvar 'cmdecho)
                  enl (entlast)
                  rtn (ssadd)
            )
            (while (setq tmp (entnext enl)) (setq enl tmp))
            (setvar 'cmdecho 0)
            (command
                "_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
                (trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) ""
            )
            (while (< 0 (getvar 'cmdactive)) (command ""))
            (entdel ent)
            (while (setq enl (entnext enl))
                (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
                         (equal (vla-get-area obj) are 1e-4)
                    )
                    (entdel enl)
                    (ssadd  enl rtn)
                )
            )
            (vla-zoomprevious app)
            (setvar 'cmdecho cmd)
            rtn
        )
    )
(setvar "clayer" cl)
)

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;



(defun dtr (a)
(* pi (/ a 180.0))
)

(defun rtd (a)
(/ (* a 180) pi)
)

(defun met2 ()
  (setvar "CMDECHO" 0)

  ; change direction to 0 and clockwise to n
  (command "units" "" "" "" "" "0" "n")
(prompt "\n East = 0")

  (setvar "CMDECHO" 1)
  (princ)
)


(defun C:rg9  ( /  acadobj activeundo adoc coords  del dis getcoords i len  ss ln entang  wid rangle)


(VL-LOAD-COM)
;;RAD TO DEG AND DEG TO RAD
(DEFUN RTD (X) ;_define  RADIAN  TO DEGREE function
  (/ (* X 180.0) PI)
) ;_  DEFUN ADD by DEVITG
;; MULTIPLY THE RAD ING BY 180  AND DIVIDE IT BY PI

(defun getcoords (ln) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ln))))
(defun lst->str (lst del) (apply 'strcat (append (list (car lst)) (mapcar '(lambda (x) (strcat del x)) (cdr lst)))))
(setq acadobj (vlax-get-acad-object)
adoc (vla-get-ActiveDocument acadobj)
activeundo nil)
  (setvar "orthomode" 0 )
(setvar "osmode" 0)
(command "_.undo" "_begin")
   (setq
aunit (getvar 'aunits)
osm (getvar 'osmode)
blips (getvar 'blipmode)
curlay (getvar 'clayer)
)
  (setvar 'osmode 0)
  (setvar 'blipmode 0)
  (setvar 'aunits 3); radians

(if ( not anginc ) (setq anginc  45 ) )
(setq btemp-wi (getint (strcat "\n angle   <"  (rtos anginc)  ">:")) )
(if btemp-wi (setq anginc btemp-wi))

(setq anginc (dtr anginc) )
(setq d 2000)

(setq lines (ssadd) )


(command "-Layer" "m" "newrect"  "c" "150" "newrect" "")

(command "-layer" "s" "newrect" "")


 


(setq ss (ssget '((0 . "LWPOLYLINE") )))

(repeat (setq i (sslength ss))



   (setq   entang (ssname ss (setq i (1- i))) )
   (setq coords (getcoords entang ))
   (setq ent  (ssname ss (setq i (1- i))))
   (setq dis (mapcar 'distance coords (cdr coords)))
   (setq rangle (mapcar 'angle coords (cdr coords)))
   
   (cond
((< (nth 0 dis) (nth 1 dis)) (setq wid (nth 0 dis)) (setq len (nth 1 dis)) (setq rect-angle (rtd (nth 1 rangle))) )
((>= (nth 0 dis) (nth 1 dis)) (setq wid (nth 1 dis)) (setq len (nth 0 dis)) (setq rect-angle (rtd (nth 0 rangle))) )
   )
 
 
   ; my adds
 
   (SETQ MID-PT-xy (MAPCAR '* '(0.5 0.5 0.8) (MAPCAR '+ (nth 0 coords) (nth 2 coords))))
   (setq MID-PT-x (nth 0 MID-PT-xy))
   (setq MID-PT-y (nth 1 MID-PT-xy))
   ;end my adds
   
     (setvar 'aunits 0); radians
   (command "rotate" entang ""  "_non" MID-PT-xy  (- 360 rect-angle )  )
(setvar 'aunits 3); radians

(command "_.explode" entang)


(setq plpcs (ssget "_P"))

(repeat (sslength plpcs)
  (setq plpc (ssname plpcs 0))
  (if (= (cdr (assoc 0 (entget plpc))) "LINE") (ssadd plpc lines))
  (ssdel plpc plpcs)
); end repeat


(setq sslist (ssadd))


(repeat (sslength lines)

(setq
  ln (ssname lines 0)
  lndata (entget ln)
  lnend1 (cdr (assoc 10 lndata))
  lnend2 (cdr (assoc 11 lndata))
  lnang (angle lnend1 lnend2)
  lnmid (mapcar '/ (mapcar '+ lnend1 lnend2) '(2 2 2))
  lnangnew
(if (zerop anginc)
  0
  (* (fix (+ (/ lnang anginc) 0.5)) anginc)
); end if & lnangnew
); end setq


(setq lndata (subst (cons 10 (polar lnend2 lnang d)) (assoc 10 lndata) lndata)
   lndata (subst (cons 11 (polar lnend1 (+ lnang pi) d)) (assoc 11 lndata) lndata)
)
(entmod lndata)

(setvar 'osmode 0)
(setvar 'aunits 3);
(command "_.rotate" ln "" lnmid "_reference" lnang lnangnew)

(setvar 'aunits 3);
(ssadd ln sslist)

(ssdel ln lines)

;;(LM:outline sel)



(LM:outline sslist)
                                   


); end repeat




  (setq newnet (ssget "_l"))

(setvar 'aunits 0);

(command "rotate"  newnet ""  "_non" MID-PT-xy  (+ 360 rect-angle )  )



(command "_erase"  plpcs "")
   


) ;_  repeat


(command "_.undo" "_end")
)

 













15
AutoLISP (Vanilla / Visual) / Re: How to draw?
« Last post by Tharwat on July 03, 2022, 12:44:42 PM »
Use getpoint & getcorn functions then create the center lines based on width & length of the imaginary rectangle.
16
AutoLISP (Vanilla / Visual) / Re: How to draw?
« Last post by didier on July 03, 2022, 12:04:42 PM »
Bonjour

I would say that the centerline command is perfect, but you should know more about the qualities of your entities if this native command is not the solution.

Amicalement
17
AutoLISP (Vanilla / Visual) / How to draw?
« Last post by masao on July 03, 2022, 10:45:35 AM »
How to draw center line?
18
AutoLISP (Vanilla / Visual) / Re: Layouts and ObjectDBX
« Last post by Lee Mac on July 03, 2022, 07:06:34 AM »
For an existing example, consider 'Example 4' on the page for my ObjectDBX Wrapper function; as Roy has indicated in his earlier post, the key is to iterate over the objects found within the block container for the layout.
19
.NET / Re: Select Parcels by polyline
« Last post by d2010 on July 03, 2022, 06:44:58 AM »
You must share a demo as Drawing.dwg
How to upload
You make a video , manually on youtube.com, and the program make exactly same
steps as this video/mp4.
20
AutoLISP (Vanilla / Visual) / Re: How to operate a 64 bit long long integer?
« Last post by baitang36 on July 02, 2022, 11:45:12 PM »
Quote from: d2010 on June 29, 2022, 04:23:25 PM
Okai
(setq aa(vlax-variant-value(vlax-make-variant 15000000000 20)))
How to read the "aa"?
How to add the aa+other number?
How to divide aa / int32?
aa is INT,but can not add sub
Pages: 1 [2] 3 4 ... 10