Jump to content

LISP missing a line.


aawilds

Recommended Posts

I have the code below to place a block on a point. Then array that block based on information given by the user. Then move all of the blocks so that the insertion point is the top and center of all the blocks. It works fine sometimes but about half the time it it skips the first move command. Could someone tell me what I am missing?

 

(DEFUN C:COMEDARRAY ( / OLDL NOR NOC CEB CEP )
 (SETQ OLDL (GETVAR "CLAYER"))
 (COMMAND "_LAYER" "SET" "ELEC-CE" "")
 (SETQ NOR (GETINT "\nENTER NUMBER OF COMED ROWS: "))
 (SETQ NOC (GETINT "\nENTER NUMBER OF COMED COLUMNS: "))
 (setq CEP1 (getpoint "\nPICK INSERT POINT FOR BLOCK: "))
 (COMMAND "_INSERT" "S:\\LightSett\\LISP FILES\\LISP USED BLOCKS\\COMED PROFILE.DWG" CEP1 "" "" "")
 (SETQ CEB (ENTLAST))
 (COMMAND "_ARRAY" CEB "" "R" NOR NOC 0.6667 0.3333)
 (SETQ CEP (SSGET '((0 . "INSERT"))))
 (COMMAND "_MOVE" CEP "" CEP1 (cons (- (CAR CEP1) (/ (* NOC 0.3333) 2)) (CDR CEP1)))
 (COMMAND "_MOVE" CEP "" CEP1 (LIST (CAR CEP1) (- (CADR CEP1) (* NOR 0.6667)) (CADDR CEP1)))
 (command "layer" "set" OLDL "")
 (PRINC)
 )

comed array.PNG

Link to comment
Share on other sites

My 5 cent NOT TESTED

(defun c:comedarray ( / oldl nor noc ceb cep )

 (if (and
(setq nor (cond ((getint (strcat "\nEnter number of comed rows: " (itoa (setq nor (cond ( nor ) ( 1 )))) ))) ( nor )))
(setq noc (cond ((getint (strcat "\nEnter number of comed columns: " (itoa (setq noc (cond ( noc ) ( 1 )))) ))) ( noc )))
(setq cep1 (getpoint "\npick insert point for block: "))
)
   (progn
     (if (vl-file-directory-p "s:\\lightsett\\lisp files\\lisp used blocks")
(progn
  (setq oldl (getvar "clayer"))
  (mapcar '(lambda ( a b c d ) (MakeLayer a b "Continuous" c T 0 d))
	  '("ELEC-CE")
	  '( 1 )
	  '( 0.09 )
	  '("Elect" "" )
	  )
  (setvar "clayer" "ELEC-CE" )
  (vl-cmdf "_.-insert" "s:\\lightsett\\lisp files\\lisp used blocks\\comed profile.dwg" cep1 "1" "1" "0")		; insert block
  (setq ceb (entlast))
  (vl-cmdf "_array" ceb "" "r" nor noc 0.6667 0.3333)
  (setq cep (ssget "x" (list (cons 0 "INSERT") (cons 2 "comed profile"))))
  (vl-cmdf "_move" cep "" cep1 (cons (- (car cep1) (/ (* noc 0.3333) 2)) (cdr cep1)))
  (vl-cmdf "_move" cep "" cep1 (list (car cep1) (- (cadr cep1) (* nor 0.6667)) (caddr cep1)))
  (setvar "clayer" oldl )
  ))
     ))
 (princ)
 )
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
   ;; (MakeLayer name colour linetype lineweight willplot bitflag description )
   ;; Specifications:
   ;; Description        Data Type        Remarks
   ;; -----------------------------------------------------------------
   ;; Layer Name          STRING          Only standard chars allowed			
   ;; Layer Colour        INTEGER         may be nil, -ve for Layer Off, Colour < 256	
   ;; Layer Linetype      STRING          may be nil, If not loaded, CONTINUOUS.	
   ;; Layer Lineweight    REAL            may be nil, 0 <= x <= 2.11			
   ;; Plot?               BOOLEAN         T = Plot Layer, nil otherwise		
   ;; Bit Flag            INTEGER         0=None, 1=Frozen, 2=Frozen in VP, 4=Locked	
   ;; Description         STRING          may be nil for no description		
   ;; Function will return list detailing whether layer creation is successful.	
   ;; © Lee Mac 2010
 
 (regapp "AcAecLayerStandard")
 (or (tblsearch "LAYER" name)
   (entmake
     (append
       (list
         (cons 0	"LAYER")
         (cons 100	"AcDbSymbolTableRecord")
         (cons 100	"AcDbLayerTableRecord")
         (cons 2	name)
         (cons 70	bitflag)
         (cons 290	(if willplot 1 0))
         (cons 6	(if (and linetype (tblsearch "LTYPE" linetype)) linetype "CONTINUOUS"))
         (cons 62	(if (and colour (< 0 (abs colour) 256)) colour 7))
         (cons 370	(fix (* 100 (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0))))
  )
(if description (list (list -3 (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description)))))
))))

Link to comment
Share on other sites

is your block always new to your drawing or is it sometimes allready present? In that case autocad will add extra prompt if you want to redefine this block. You might want to check if block is present with tblsearch or use -insert blk=s:... or use expert variable

 

gr.Rlx

Link to comment
Share on other sites

Since the code in the OP uses command calls the problem is likely caused by the OSMODE setting. To avoid undesirable object snapping when using command calls you can either temporarily change the OSMODE setting to 0 or use this principle:

(command "_.move" ss "" "_non" pt1 "_non" pt2)

Link to comment
Share on other sites

Since the code in the OP uses command calls the problem is likely caused by the OSMODE setting. To avoid undesirable object snapping when using command calls you can either temporarily change the OSMODE setting to 0 or use this principle:

(command "_.move" ss "" "_non" pt1 "_non" pt2)

 

 

You're probably right and it was my first thought also but OP stated it (totally?) skipped move command so that's why it would have been my second suggestion :-)

 

 

Gr. Rlx

Link to comment
Share on other sites

Keep your osmode simple and save the defuns in your library lisp if you have one then you call it in every routine with a simple (oszero) (osold) (osx 512) or add to Acaddoc.lsp.

 

(defun oszero ( / )
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
)

(defun osold ( / )(setvar 'osmode oldsnap))

(defun osx (x / ) (setvar 'osmode x))

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...